From 1027b424c27ce7660d3a59a3c5de97c958a465ce Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 23 Apr 2015 17:09:19 +0900 Subject: [PATCH] Adding tests to ensure packages with failing tests aren't installed without confirmation. --- tests/snow/repo1/leonardo/fibonacci-test.scm | 2 +- tests/snow/repo2/leonardo/fibonacci-test.scm | 2 +- tests/snow/repo3/pingala/prosody-test.sld | 2 +- tests/snow/repo3/recorde/equal-test.sld | 30 +++++++++++++ tests/snow/repo3/recorde/equal.sld | 10 +++++ tests/snow/snow-tests.scm | 45 +++++++++++++------- 6 files changed, 73 insertions(+), 18 deletions(-) create mode 100644 tests/snow/repo3/recorde/equal-test.sld create mode 100644 tests/snow/repo3/recorde/equal.sld diff --git a/tests/snow/repo1/leonardo/fibonacci-test.scm b/tests/snow/repo1/leonardo/fibonacci-test.scm index 5c84da2f..a0d6bd51 100644 --- a/tests/snow/repo1/leonardo/fibonacci-test.scm +++ b/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)) diff --git a/tests/snow/repo2/leonardo/fibonacci-test.scm b/tests/snow/repo2/leonardo/fibonacci-test.scm index 5c84da2f..a0d6bd51 100644 --- a/tests/snow/repo2/leonardo/fibonacci-test.scm +++ b/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)) diff --git a/tests/snow/repo3/pingala/prosody-test.sld b/tests/snow/repo3/pingala/prosody-test.sld index aee6de60..64293d41 100644 --- a/tests/snow/repo3/pingala/prosody-test.sld +++ b/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) diff --git a/tests/snow/repo3/recorde/equal-test.sld b/tests/snow/repo3/recorde/equal-test.sld new file mode 100644 index 00000000..f9ce462b --- /dev/null +++ b/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)))) diff --git a/tests/snow/repo3/recorde/equal.sld b/tests/snow/repo3/recorde/equal.sld new file mode 100644 index 00000000..799797b4 --- /dev/null +++ b/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))))) diff --git a/tests/snow/snow-tests.scm b/tests/snow/snow-tests.scm index e50b153a..6b468fa5 100644 --- a/tests/snow/snow-tests.scm +++ b/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