Import guile-1.8 as multiple upstream tarball component

[lilypond.git] / guile18 / benchmark-suite / benchmarks / uniform-vector-read.bm

diff --git a/guile18/benchmark-suite/benchmarks/uniform-vector-read.bm b/guile18/benchmark-suite/benchmarks/uniform-vector-read.bm
new file mode 100644 (file)
index 0000000..d288f0b
--- /dev/null
+++ b/guile18/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))
+
+\f
+(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))))