Add `uniform-vector-read!' benchmark.

benchmark-suite/Makefile.am

@@ -1,8 +1,9 @@
-SCM_BENCHMARKS = benchmarks/0-reference.bm	\
+SCM_BENCHMARKS = benchmarks/0-reference.bm		\
-	         benchmarks/continuations.bm	\
+	         benchmarks/continuations.bm		\
-                 benchmarks/if.bm		\
+                 benchmarks/if.bm			\
-                 benchmarks/logand.bm		\
+                 benchmarks/logand.bm			\
-		 benchmarks/read.bm
+		 benchmarks/read.bm			\
+		 benchmarks/uniform-vector-read.bm
 
 EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS)	\
 	     ChangeLog-2008

benchmark-suite/benchmarks/uniform-vector-read.bm

@@ -0,0 +1,53 @@
+;;; uniform-vector-read.bm --- Exercise binary I/O primitives.  -*- Scheme -*-
+;;;
+;;; Copyright (C) 2008 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;; Boston, MA 02110-1301 USA
+
+(define-module (benchmarks uniform-vector-read)
+  :use-module (benchmark-suite lib)
+  :use-module (srfi srfi-4))
+
+(define file-name
+  (tmpnam))
+
+(define %buffer-size
+  7777)
+
+(define buf
+  (make-u8vector %buffer-size))
+
+(define str
+  (make-string %buffer-size))
+
+
+(with-benchmark-prefix "uniform-vector-read!"
+
+  (benchmark "uniform-vector-write" 500
+    (let ((output (open-output-file file-name)))
+      (uniform-vector-write buf output)
+      (close output)))
+
+  (benchmark "uniform-vector-read!" 500
+    (let ((input (open-input-file file-name)))
+      (setvbuf input _IONBF)
+      (uniform-vector-read! buf input)
+      (close input)))
+
+  (benchmark "string port" 5000
+    (let ((input (open-input-string str)))
+      (uniform-vector-read! buf input)
+      (close input))))