From 87aeea3162b6488a0bcee7b602314d60eba04342 Mon Sep 17 00:00:00 2001
From: Freja Nordsiek <address@hidden>
Date: Sat, 17 Jun 2017 01:42:25 +0200
Subject: [PATCH] Added initial tests for R7RS-small.

* test-suite/Makefile.am: Added R7RS tests to the list.
* test-suite/tests/r7rs-base.test (new file): Tests for (scheme base).
* test-suite/tests/r7rs-char.test (new file): Tests for (scheme char).
* test-suite/tests/r7rs-lazy.test (new file): Tests for (scheme lazy).
* test-suite/tests/r7rs-time.test (new file): Tests for (scheme time).
---
 test-suite/Makefile.am          |   4 +
 test-suite/tests/r7rs-base.test | 355 ++++++++++++++++++++++++++++++++++++++++
 test-suite/tests/r7rs-char.test |  37 +++++
 test-suite/tests/r7rs-lazy.test |  30 ++++
 test-suite/tests/r7rs-time.test |  43 +++++
 5 files changed, 469 insertions(+)
 create mode 100644 test-suite/tests/r7rs-base.test
 create mode 100644 test-suite/tests/r7rs-char.test
 create mode 100644 test-suite/tests/r7rs-lazy.test
 create mode 100644 test-suite/tests/r7rs-time.test

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index a050f83..1eb8dcf 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -114,6 +114,10 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/r6rs-records-syntactic.test	\
 	    tests/r6rs-unicode.test		\
 	    tests/rnrs-libraries.test		\
+	    tests/r7rs-base.test		\
+	    tests/r7rs-char.test		\
+	    tests/r7rs-lazy.test		\
+	    tests/r7rs-time.test		\
 	    tests/ramap.test			\
 	    tests/rdelim.test			\
 	    tests/reader.test			\
diff --git a/test-suite/tests/r7rs-base.test b/test-suite/tests/r7rs-base.test
new file mode 100644
index 0000000..e2e9dea
--- /dev/null
+++ b/test-suite/tests/r7rs-base.test
@@ -0,0 +1,355 @@
+;;; r7rs-base.test --- Test suite for R7RS (scheme base)
+
+;;      Copyright (C) 2017 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-r7rs-base)
+  :use-module ((scheme base))
+  :use-module ((scheme char))
+  :use-module ((scheme file))
+  :use-module ((rnrs bytevectors) #:select (bytevector->u8-list u8-list->bytevector))
+  :use-module ((rnrs io ports) #:select (port-position make-i/o-filename-error make-i/o-read-error))
+  :use-module ((srfi srfi-1))
+  :use-module (test-suite lib))
+
+
+(define thai-digits "\u0E50\u0E51\u0E52\u0E53\u0E54\u0E55\u0E56\u0E57\u0E58\u0E59")
+
+;;; Conversion gotten using CPython 3.5.2
+(define thai-digits-utf8 #vu8(224 185 144 224 185 145 224 185 146 224 185 147 224 185 148 224
+                                185 149 224 185 150 224 185 151 224 185 152 224 185 153))
+
+(define (grab-error thunk)
+  (let ((obj '()))
+    (guard (con ((= 1 1) (set! obj con))) (thunk))
+    obj))
+
+
+(with-test-prefix "read-error?"
+  (pass-if "read-error? true for i/o-read-error" (read-error? (make-i/o-read-error "hi")))
+  (pass-if "read-error? false for integer" (not (read-error? -4)))
+  (pass-if "read-error? false for file error" (not (read-error? (make-i/o-filename-error "hal")))))
+
+(with-test-prefix "file-error?"
+  (pass-if "file-error? true" (file-error? (make-i/o-filename-error "hal")))
+  (pass-if "file-error? false for integer" (not (file-error? -4)))
+  (pass-if "file-error? false for read error"
+    (not (file-error? (grab-error (lambda () (read "blaf8vhe")))))))
+
+(with-test-prefix "features"
+  (pass-if "features list" (list? (features)))
+  (pass-if "features equal to %cond-expand-features"
+    (list= symbol=? (features) %cond-expand-features)))
+
+(with-test-prefix "square"
+  (pass-if "square same as (* x x)"
+    (let ((nums (append '(8.0 3/4 -3.3 -8) (iota 100))))
+      (list= = (map square nums) (map (lambda (x) (* x x)) nums)))))
+
+(with-test-prefix "string->vector"
+  (pass-if "string->vector vector" (vector? (string->vector "aivi38vaAfva8hga#$")))
+  (pass-if "string->vector compare to string->list"
+    (let ((s "a9vaEAva88nn4 aaiavAv aieavafa==34\av aA#$a"))
+      (list= char=? (vector->list (string->vector s)) (string->list s)))))
+
+(with-test-prefix "vector->string"
+  (pass-if "vector->string string" (string? (vector->string #(#\a #\b #\c #\d))))
+  (pass-if "vector->string compare to vector->list"
+    (let ((v #(#\a #\5 #\E #\% #\space)))
+      (list= char=? (string->list (vector->string v)) (vector->list v)))))
+
+(with-test-prefix "string->utf8"
+  (pass-if "string->utf8 bytevector" (bytevector? (string->utf8 "a9v3naaviavaF#aavi3A\u0E59")))
+  (pass-if "string->utf8 ascii digits"
+    (list= = (bytevector->u8-list (string->utf8 "0123456789")) (iota 10 48)))
+  (pass-if "string->utf8 length increases for non-ascii"
+    (let ((s thai-digits))
+      (> (bytevector-length (string->utf8 s)) (string-length s)))))
+
+(with-test-prefix "utf8->string"
+  (pass-if "utf8->string string" (string? (utf8->string (u8-list->bytevector (iota 10 48)))))
+  (pass-if "utf8->string length decreases for non-ascii"
+    (let ((bv thai-digits-utf8))
+      (> (bytevector-length bv) (string-length (utf8->string bv)))))
+  (pass-if "utf8->string works for Thai digits"
+    (string=? (utf8->string thai-digits-utf8) thai-digits)))
+
+(with-test-prefix "string-map"
+  (pass-if "string-map char-downcase"
+    (let ((s "aavieEAIVAeaneai#aa9va#$"))
+      (string=? (string-map char-downcase s) (string-downcase s))))
+  (pass-if "string-map selective char grab"
+    (let ((s1 "ueANezvfiHviae")
+          (s2 "UEanEZVFIhVIAE"))
+      (string=? (string-upcase s1) (string-map (lambda (x y) (if (char>? x y) y x)) s1 s2)))))
+
+(with-test-prefix "string-for-each"
+  (pass-if "string-for-each look for char"
+    (let ((s "avienfvavRau3$ava8vae#Afa")
+          (chr #\R)
+          (found #f))
+      (string-for-each (lambda (c)(if (char=? chr c) (set! found #t))) s)
+      found)))
+
+(with-test-prefix "bytevector"
+  (pass-if "bytevector bytevector" (bytevector? (bytevector 3 9 32 204)))
+  (pass-if "bytevector apply to u8 list"
+    (let ((lst '(3 48 110 30 253 0)))
+      (list= = (bytevector->u8-list (apply bytevector lst)) lst))))
+
+(with-test-prefix "bytevector-append"
+  (pass-if "bytevector-append bytevector" (bytevector? (bytevector-append #vu8(3 2) #vu8(90))))
+  (pass-if "bytevector-append three u8 lists"
+    (let ((lst1 '(38 8 20 0 255))
+          (lst2 '(82))
+          (lst3 '(5 9 200 138)))
+      (list= = (append lst1 lst2 lst3)
+             (bytevector->u8-list (bytevector-append (u8-list->bytevector lst1)
+                                                     (u8-list->bytevector lst2)
+                                                     (u8-list->bytevector lst3)))))))
+
+(with-test-prefix "bytevector-copy!"
+  (pass-if "bytevector-copy!"
+    (let ((bv-t #vu8(0 0 0 0 0 0 0 0))
+          (bv-s #vu8(1 2 3))
+          (bv-r #vu8(0 0 0 1 2 3 0 0)))
+      (bytevector-copy! bv-t 3 bv-s)
+      (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r))))
+  (pass-if "bytevector-copy! with source-start"
+    (let ((bv-t #vu8(0 0 0 0 0 0 0 0))
+          (bv-s #vu8(1 2 3))
+          (bv-r #vu8(0 0 0 2 3 0 0 0)))
+      (bytevector-copy! bv-t 3 bv-s 1)
+      (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r))))
+  (pass-if "bytevector-copy! with source-start and source-end"
+    (let ((bv-t #vu8(0 0 0 0 0 0 0 0))
+          (bv-s #vu8(1 2 3))
+          (bv-r #vu8(0 0 0 2 0 0 0 0)))
+      (bytevector-copy! bv-t 3 bv-s 1 2)
+      (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r)))))
+
+(with-test-prefix "bytevector output port"
+  (pass-if "open-output-bytevector open binary output port"
+    (let ((p (open-output-bytevector)))
+      (and (port? p) (output-port? p) (binary-port? p) (not (port-closed? p)))))
+  (pass-if "get-output-bytevector bytevector"
+    (bytevector? (get-output-bytevector (open-output-bytevector))))
+  (pass-if "write and read back"
+    (let ((p (open-output-bytevector))
+          (bv (u8-list->bytevector (iota 256))))
+      (write-bytevector bv p)
+      ;; Compare twice to make sure get-output-bytevector doesn't cause
+      ;; bytevector output port to be cleared.
+      (let ((read1 (get-output-bytevector p))
+            (read2 (get-output-bytevector p)))
+        (close-port p)
+        (and (list= = (bytevector->u8-list bv) (bytevector->u8-list read1))
+             (list= = (bytevector->u8-list bv) (bytevector->u8-list read2)))))))
+
+(with-test-prefix "input-port-open?"
+  (pass-if "input-port-open? true on open input port"
+    (boolean=? #t (input-port-open? (open-input-string "abeeU"))))
+  (pass-if "input-port-open? false on closed input port"
+    (let ((p (open-input-string "avie$av9a")))
+      (close-port p)
+      (boolean=? #f (input-port-open? p))))
+  (pass-if "input-port-open? false on output port"
+    (call/cc
+     (lambda (cont)
+       (with-exception-handler (lambda (a) (cont #t))
+         (lambda () (cont (boolean=? #f (input-port-open? (open-output-string)))))))))
+  (pass-if "input-port-open? error or false on integer"
+    (call/cc
+     (lambda (cont)
+       (with-exception-handler (lambda (a) (cont #t))
+         (lambda () (cont (boolean=? #f (input-port-open? 3)))))))))
+
+(with-test-prefix "output-port-open?"
+  (pass-if "output-port-open? true on open output port"
+    (boolean=? #t (output-port-open? (open-output-string))))
+  (pass-if "output-port-open? false on closed output port"
+    (let ((p (open-output-string)))
+      (close-port p)
+      (boolean=? #f (output-port-open? p))))
+  (pass-if "output-port-open? false on input port"
+    (call/cc
+     (lambda (cont)
+       (with-exception-handler (lambda (a) (cont #t))
+         (lambda () (cont (boolean=? #f (output-port-open? (open-input-string)))))))))
+  (pass-if "output-port-open? error or false on integer"
+    (call/cc
+     (lambda (cont)
+       (with-exception-handler (lambda (a) (cont #t))
+         (lambda () (cont (boolean=? #f (output-port-open? 3)))))))))
+
+(with-test-prefix "peek-u8"
+  (pass-if "peek-u8 read byte and doesn't advance"
+    (let* ((bv #vu8(239 39 184 94 38))
+           (p (open-input-bytevector bv))
+           (value (peek-u8 p))
+           (pos (port-position p)))
+      (close-port p)
+      (and (= pos 0) (= value (bytevector-u8-ref bv 0))))))
+
+(with-test-prefix "read-u8"
+  (pass-if "read-u8 read byte and does advance"
+    (let* ((bv #vu8(239 39 184 94 38))
+           (p (open-input-bytevector bv))
+           (value (read-u8 p))
+           (pos (port-position p)))
+      (close-port p)
+      (and (= pos 1) (= value (bytevector-u8-ref bv 0))))))
+
+(with-test-prefix "write-u8"
+  (pass-if "write-u8 write byte and does advance"
+    (let ((value 47)
+          (p (open-output-bytevector)))
+      (write-u8 value p)
+      (and (= (port-position p) 1)
+           (list= = (list value) (bytevector->u8-list (get-output-bytevector p)))))))
+
+(with-test-prefix "read-bytevector"
+  (pass-if "read-bytevector read correctly"
+    (let* ((bv #vu8(239 39 184 94 38))
+           (num-to-read 3)
+           (p (open-input-bytevector bv))
+           (value (read-bytevector num-to-read p))
+           (pos (port-position p)))
+      (close-port p)
+      (and (= pos num-to-read) (list= = (bytevector->u8-list value)
+                                      (list-head (bytevector->u8-list bv) num-to-read))))))
+
+(with-test-prefix "read-bytevector!"
+  (pass-if "read-bytevector! read"
+    (let* ((bv-s #vu8(1 2 3 4 5 6))
+           (bv-t #vu8(0 0 0))
+           (bv-correct #vu8(1 2 3))
+           (p (open-input-bytevector bv-s))
+           (num-read (read-bytevector! bv-t p))
+           (pos (port-position p)))
+      (close-port p)
+      (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct))
+           (= pos num-read)
+           (= num-read (bytevector-length bv-t)))))
+  (pass-if "read-bytevector! read with start"
+    (let* ((bv-s #vu8(1 2 3 4 5 6))
+           (bv-t #vu8(0 0 0))
+           (bv-correct #vu8(0 1 2))
+           (p (open-input-bytevector bv-s))
+           (num-read (read-bytevector! bv-t p 1))
+           (pos (port-position p)))
+      (close-port p)
+      (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct))
+           (= pos num-read)
+           (= (+ 1 num-read) (bytevector-length bv-t)))))
+  (pass-if "read-bytevector! read with start and end"
+    (let* ((bv-s #vu8(1 2 3 4 5 6))
+           (bv-t #vu8(0 0 0))
+           (bv-correct #vu8(0 1 0))
+           (p (open-input-bytevector bv-s))
+           (num-read (read-bytevector! bv-t p 1 2))
+           (pos (port-position p)))
+      (close-port p)
+      (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct))
+           (= pos num-read)
+           (= (+ 2 num-read) (bytevector-length bv-t))))))
+
+(with-test-prefix "write-bytevector"
+  (pass-if "write-bytevector write"
+    (let ((bv #vu8(1 2 3 4 5 6))
+          (bv-correct #vu8(1 2 3 4 5 6))
+          (p (open-output-bytevector)))
+      (write-bytevector bv p)
+      (and (list= = (bytevector->u8-list (get-output-bytevector p))
+                  (bytevector->u8-list bv-correct))
+           (= (port-position p) (bytevector-length bv-correct)))))
+  (pass-if "write-bytevector write with start"
+    (let ((bv #vu8(1 2 3 4 5 6))
+          (bv-correct #vu8(3 4 5 6))
+          (p (open-output-bytevector)))
+      (write-bytevector bv p 2)
+      (and (list= = (bytevector->u8-list (get-output-bytevector p))
+                  (bytevector->u8-list bv-correct))
+           (= (port-position p) (bytevector-length bv-correct)))))
+  (pass-if "write-bytevector write with start and end"
+    (let ((bv #vu8(1 2 3 4 5 6))
+          (bv-correct #vu8(3 4 5))
+          (p (open-output-bytevector)))
+      (write-bytevector bv p 2 5)
+      (and (list= = (bytevector->u8-list (get-output-bytevector p))
+                  (bytevector->u8-list bv-correct))
+           (= (port-position p) (bytevector-length bv-correct))))))
+
+(with-test-prefix "read-string"
+  (pass-if "read-string read"
+    (let* ((str-s "aiviEenvae")
+           (count 5)
+           (str-correct "aiviE")
+           (p (open-input-string str-s))
+           (str-out (read-string count p))
+           (pos (port-position p)))
+      (close-port p)
+      (and (string=? str-out str-correct) (= count (string-length str-out)) (= count pos)))))
+
+(with-test-prefix "write-string"
+  (pass-if "write-string write"
+    (let* ((str-s "a*viRaiv")
+           (str-correct str-s)
+           (p (open-output-string)))
+      (write-string str-s p)
+      (let ((str-out (get-output-string p))
+            (pos (port-position p)))
+        (close-port p)
+        (and (string=? str-out str-correct) (= pos (string-length str-out))))))
+  (pass-if "write-string write with start"
+    (let ((str-s "a*viRaiv")
+          (str-correct "iRaiv")
+          (p (open-output-string)))
+      (write-string str-s p 3)
+      (let ((str-out (get-output-string p))
+            (pos (port-position p)))
+        (close-port p)
+        (and (string=? str-out str-correct) (= pos (string-length str-out))))))
+  (pass-if "write-string write with start and end"
+    (let ((str-s "a*viRaiv")
+          (str-correct "iRa")
+          (p (open-output-string)))
+      (write-string str-s p 3 6)
+      (let ((str-out (get-output-string p))
+            (pos (port-position p)))
+        (close-port p)
+        (and (string=? str-out str-correct) (= pos (string-length str-out)))))))
+
+(with-test-prefix "read-line"
+  (pass-if "read-line read"
+    (let ((p (open-output-string)))
+      (newline p)
+      (let ((linefeed (get-output-string p))
+            (line1 "avaie$Ava 3fai")
+            (line2 "vi38va$#ava aaf ")
+            (po (open-output-string)))
+        (write-string line1 po)
+        (newline po)
+        (write-string line2 po)
+        (newline po)
+        (let* ((str-intermediate (get-output-string po))
+               (pi (open-input-string str-intermediate))
+               (str-out (read-line pi)))
+          (close-port p)
+          (close-port po)
+          (close-port pi)
+          (string=? str-out line1))))))
diff --git a/test-suite/tests/r7rs-char.test b/test-suite/tests/r7rs-char.test
new file mode 100644
index 0000000..722b756
--- /dev/null
+++ b/test-suite/tests/r7rs-char.test
@@ -0,0 +1,37 @@
+;;; r7rs-char.test --- Test suite for R7RS (scheme char)
+
+;;      Copyright (C) 2017 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-r7rs-char)
+  :use-module ((scheme char))
+  :use-module ((srfi srfi-1))
+  :use-module (test-suite lib))
+
+
+(define (test-zero-to-nine s)
+  (every equal? (iota 10) (map digit-value (string->list s))))
+
+(with-test-prefix "digit-value"
+  (pass-if "digit-values true on ascii digits" (test-zero-to-nine "0123456789"))
+  (pass-if "digit-values true on Thai digits"
+    (test-zero-to-nine "\u0E50\u0E51\u0E52\u0E53\u0E54\u0E55\u0E56\u0E57\u0E58\u0E59"))
+  (pass-if "digit-values false on ascii letters"
+    (not (any digit-value
+              (string->list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))))
+  (pass-if "digit-values false on whitespace"
+    (not (any digit-value (char-set->list char-set:whitespace)))))
diff --git a/test-suite/tests/r7rs-lazy.test b/test-suite/tests/r7rs-lazy.test
new file mode 100644
index 0000000..d8156f5
--- /dev/null
+++ b/test-suite/tests/r7rs-lazy.test
@@ -0,0 +1,30 @@
+;;; r7rs-lazy.test --- Test suite for R7RS (scheme lazy)
+
+;;      Copyright (C) 2017 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-r7rs-lazy)
+  :use-module ((scheme lazy) #:select ((delay . sl-delay) (promise? . sl-promise?)
+                                       (make-promise . sl-make-promise) (force . sl-force)))
+  :use-module (test-suite lib))
+
+
+(with-test-prefix "make-promise"
+  (pass-if "make-promise on integer" (sl-promise? (sl-make-promise 3)))
+  (pass-if "make-promise on promise"
+    (let ((p (sl-delay (+ 3.28832193 8))))
+      (and (sl-promise? p) (inexact? (sl-force p))))))
diff --git a/test-suite/tests/r7rs-time.test b/test-suite/tests/r7rs-time.test
new file mode 100644
index 0000000..6453128
--- /dev/null
+++ b/test-suite/tests/r7rs-time.test
@@ -0,0 +1,43 @@
+;;; r7rs-time.test --- Test suite for R7RS (scheme time)
+
+;;      Copyright (C) 2017 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-suite test-r7rs-time)
+  :use-module ((scheme time))
+  :use-module (test-suite lib))
+
+
+(with-test-prefix "jiffies-per-second"
+  (pass-if "jiffies-per-second integer" (integer? (jiffies-per-second)))
+  (pass-if "jiffies-per-second positive" (> (jiffies-per-second) 0)))
+
+(with-test-prefix "current-second"
+  (pass-if "current-second inexact" (inexact? (current-second)))
+  (pass-if "current-second increasing"
+    (let ((first-time (current-second)))
+      (sleep 2)
+      (let ((second-time (current-second)))
+        (< first-time second-time)))))
+
+(with-test-prefix "current-jiffy"
+  (pass-if "current-jiffy exact" (exact? (current-jiffy)))
+  (pass-if "current-jiffy increasing"
+    (let ((first-time (current-jiffy)))
+      (sleep 2)
+      (let ((second-time (current-jiffy)))
+        (< first-time second-time)))))
-- 
2.9.4