Adding tests to ensure packages with failing tests aren't installed without confirmation.

tests/snow/repo1/leonardo/fibonacci-test.scm

@@ -4,7 +4,7 @@
   (cond
    ((not (equal? expect expr))
     (write-string "FAIL\n")
-    (exit 1))))
+    (exit #f))))
 
 (test 1 (fib 0))
 (test 1 (fib 1))

tests/snow/repo2/leonardo/fibonacci-test.scm

@@ -4,7 +4,7 @@
   (cond
    ((not (equal? expect expr))
     (write-string "FAIL\n")
-    (exit 1))))
+    (exit #f))))
 
 (test 1 (fib 0))
 (test 1 (fib 1))

tests/snow/repo3/pingala/prosody-test.sld

@@ -14,7 +14,7 @@
       (display " but got: ")
       (write res)
       (newline))
-    (define (test-exit) (exit (if failed? 1 0)))
+    (define (test-exit) (exit (not failed?)))
     (define-syntax test
       (syntax-rules ()
         ((test expected expr)

tests/snow/repo3/recorde/equal-test.sld

@@ -0,0 +1,30 @@
+(define-library (recorde equal-test)
+  (export run-tests test-exit)
+  (import (except (scheme base) =)
+          (scheme inexact)
+          (scheme process-context)
+          (scheme write)
+          (recorde equal))
+  (begin
+    (define failed? #f)
+    (define (set-failed!)
+      (set! failed? #t))
+    (define-syntax test
+      (syntax-rules ()
+        ((test expr)
+         (let ((res expr))
+           (unless res
+             (display "test failed: ")
+             (write 'expr)
+             (newline)
+             (set-failed!))))))
+    (define (test-exit)
+      (when failed?
+        (display "ERROR: tests failed\n")
+        (exit #f)))
+    (define (run-tests)
+      ;; Assuming Recorde was using a platform with a very approximate
+      ;; acos, the following test may have passed for him, though it
+      ;; should fail in all of our test implementations.
+      (test (= 3 (acos -1)))
+      (test-exit))))

tests/snow/repo3/recorde/equal.sld

@@ -0,0 +1,10 @@
+;;> Robert Recorde was a Welsch physician and mathematician, and
+;;> inventor of the "equals" sign (=).
+
+(define-library (recorde equal)
+  (export =)
+  (import (except (scheme base) =))
+  (begin
+    (define epsilon 0.001)
+    (define (= a b)
+      (<= (abs (- a b)) (* (abs (max a b)) epsilon)))))

tests/snow/snow-tests.scm

@@ -175,6 +175,11 @@
       --version 1.0 --authors "Pingala" --name "(pingala triangle)"
       --description "Program to print a Sierpinski Triangle"
       --programs tests/snow/repo3/pingala/triangle.scm)
+(snow package --output-dir tests/snow/repo3/
+      --version 1.0 --authors "Robert Recorde"
+      --description "Equality implementation"
+      --test-library "tests/snow/repo3/recorde/equal-test.sld"
+      tests/snow/repo3/recorde/equal.sld)
 (snow index ,(cadr repo3))
 (snow ,@repo3 update)
 (snow ,@repo3 install pingala.binomial)
@@ -211,21 +216,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; other implementations
 
-(snow ,@repo3 update)
-(snow ,@repo3 --implementations "chicken" --program-implementation "chicken"
-      install pingala.triangle)
-(let ((status (snow-status --implementations "chicken")))
-  (test-assert (installed-version status '(pingala binomial) 'chicken))
-  (test-assert (installed-version status '(pingala factorial) 'chicken))
-  (test "1\n1 1\n1 2 1\n1 3 3 1\n"
-      (process->string '("tests/snow/tmp-root/bin/triangle" "3"))))
-
-(snow ,@repo3 update)
-(snow ,@repo3 --implementations "foment" install pingala.binomial)
-(let ((status (snow-status --implementations "foment")))
-  (test-assert (installed-version status '(pingala binomial) 'foment))
-  (test-assert (installed-version status '(pingala factorial) 'foment)))
-
 (snow ,@repo2 update)
 (snow ,@repo2 --implementations "gauche,kawa,larceny"
       install leonardo.fibonacci)
@@ -235,6 +225,20 @@
   (test "1.1" (installed-version status '(leonardo fibonacci) 'larceny)))
 
 (snow ,@repo3 update)
+
+(snow ,@repo3 --implementations "chicken" --program-implementation "chicken"
+      install pingala.triangle)
+(let ((status (snow-status --implementations "chicken")))
+  (test-assert (installed-version status '(pingala binomial) 'chicken))
+  (test-assert (installed-version status '(pingala factorial) 'chicken))
+  (test "1\n1 1\n1 2 1\n1 3 3 1\n"
+      (process->string '("tests/snow/tmp-root/bin/triangle" "3"))))
+
+(snow ,@repo3 --implementations "foment" install pingala.binomial)
+(let ((status (snow-status --implementations "foment")))
+  (test-assert (installed-version status '(pingala binomial) 'foment))
+  (test-assert (installed-version status '(pingala factorial) 'foment)))
+
 (snow ,@repo3 --implementations "gauche,kawa,larceny"
       install pingala.binomial)
 (let ((status (snow-status --implementations "gauche,kawa,larceny")))
@@ -245,6 +249,17 @@
   (test-assert (installed-version status '(pingala binomial) 'larceny))
   (test-assert (installed-version status '(pingala factorial) 'larceny)))
 
+;; this library is fine but the test fails, so this should't be installed
+(snow ,@repo3 --implementations "chibi,chicken,gauche,kawa,larceny"
+      install recorde.equal)
+(let ((status
+       (snow-status --implementations "chibi,chicken,gauche,kawa,larceny")))
+  (test-not (installed-version status '(recorde equal) 'chibi))
+  (test-not (installed-version status '(recorde equal) 'chicken))
+  (test-not (installed-version status '(recorde equal) 'gauche))
+  (test-not (installed-version status '(recorde equal) 'kawa))
+  (test-not (installed-version status '(recorde equal) 'larceny)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; smart packaging