diff --git a/Makefile b/Makefile index df563b77..3a9a2855 100644 --- a/Makefile +++ b/Makefile @@ -200,6 +200,9 @@ test-build: test-ffi: chibi-scheme$(EXE) $(CHIBI) tests/ffi/ffi-tests.scm +test-snow: chibi-scheme$(EXE) + $(CHIBI) tests/snow/snow-tests.scm + test-numbers: chibi-scheme$(EXE) $(CHIBI) -xchibi tests/numeric-tests.scm diff --git a/tests/snow/repo0/edouard/lucas.sld b/tests/snow/repo0/edouard/lucas.sld new file mode 100644 index 00000000..425f6920 --- /dev/null +++ b/tests/snow/repo0/edouard/lucas.sld @@ -0,0 +1,8 @@ +(define-library (edouard lucas) + (export lucas) + (import (scheme base)) + (begin + (define (lucas n) + (if (< n 2) + (if (= n 1) 1 2) + (+ (lucas (- n 1)) (lucas (- n 2))))))) diff --git a/tests/snow/repo1/leonardo/fibonacci-test.scm b/tests/snow/repo1/leonardo/fibonacci-test.scm new file mode 100644 index 00000000..31537274 --- /dev/null +++ b/tests/snow/repo1/leonardo/fibonacci-test.scm @@ -0,0 +1,14 @@ +(import (scheme base) (chibi test) (leonardo fibonacci)) + +(test-begin "fibonacci") + +(test 1 (fib 0)) +(test 1 (fib 1)) +(test 2 (fib 2)) +(test 3 (fib 3)) +(test 5 (fib 4)) +(test 8 (fib 5)) +(test 13 (fib 6)) + +(test-end) +(test-exit) diff --git a/tests/snow/repo1/leonardo/fibonacci.scm b/tests/snow/repo1/leonardo/fibonacci.scm new file mode 100644 index 00000000..271de0e6 --- /dev/null +++ b/tests/snow/repo1/leonardo/fibonacci.scm @@ -0,0 +1,4 @@ +(define (fib n) + (if (< n 2) + 1 + (+ (fib (- n 1)) (fib (- n 2))))) diff --git a/tests/snow/repo1/leonardo/fibonacci.sld b/tests/snow/repo1/leonardo/fibonacci.sld new file mode 100644 index 00000000..d15fc117 --- /dev/null +++ b/tests/snow/repo1/leonardo/fibonacci.sld @@ -0,0 +1,4 @@ +(define-library (leonardo fibonacci) + (export fib) + (import (scheme base)) + (include "fibonacci.scm")) diff --git a/tests/snow/repo2/leonardo/fibonacci-test.scm b/tests/snow/repo2/leonardo/fibonacci-test.scm new file mode 100644 index 00000000..31537274 --- /dev/null +++ b/tests/snow/repo2/leonardo/fibonacci-test.scm @@ -0,0 +1,14 @@ +(import (scheme base) (chibi test) (leonardo fibonacci)) + +(test-begin "fibonacci") + +(test 1 (fib 0)) +(test 1 (fib 1)) +(test 2 (fib 2)) +(test 3 (fib 3)) +(test 5 (fib 4)) +(test 8 (fib 5)) +(test 13 (fib 6)) + +(test-end) +(test-exit) diff --git a/tests/snow/repo2/leonardo/fibonacci.scm b/tests/snow/repo2/leonardo/fibonacci.scm new file mode 100644 index 00000000..912fb8b9 --- /dev/null +++ b/tests/snow/repo2/leonardo/fibonacci.scm @@ -0,0 +1,5 @@ +(define (fib n) + (let lp ((n n) (a 1) (b 1)) + (if (< n 2) + a + (lp (- n 1) (+ a b) a)))) diff --git a/tests/snow/repo2/leonardo/fibonacci.sld b/tests/snow/repo2/leonardo/fibonacci.sld new file mode 100644 index 00000000..d15fc117 --- /dev/null +++ b/tests/snow/repo2/leonardo/fibonacci.sld @@ -0,0 +1,4 @@ +(define-library (leonardo fibonacci) + (export fib) + (import (scheme base)) + (include "fibonacci.scm")) diff --git a/tests/snow/repo3/pingala/binomial-impl.scm b/tests/snow/repo3/pingala/binomial-impl.scm new file mode 100644 index 00000000..cbb37a56 --- /dev/null +++ b/tests/snow/repo3/pingala/binomial-impl.scm @@ -0,0 +1,4 @@ +(define (binomial n k) + (/ (factorial n) + (* (factorial k) + (factorial (- n k))))) diff --git a/tests/snow/repo3/pingala/binomial-test.scm b/tests/snow/repo3/pingala/binomial-test.scm new file mode 100644 index 00000000..95bfdcd1 --- /dev/null +++ b/tests/snow/repo3/pingala/binomial-test.scm @@ -0,0 +1,10 @@ +(import (scheme base) (pingala binomial) (pingala test-map)) + +(test-map (1 4 6 4 1) + (lambda (k) (binomial 4 k)) + (0 1 2 3 4)) +(test-map (1 5 10 10 5 1) + (lambda (k) (binomial 5 k)) + (0 1 2 3 4 5)) + +(test-exit) diff --git a/tests/snow/repo3/pingala/binomial.scm b/tests/snow/repo3/pingala/binomial.scm new file mode 100644 index 00000000..54b7f3f7 --- /dev/null +++ b/tests/snow/repo3/pingala/binomial.scm @@ -0,0 +1,4 @@ +(define-library (pingala binomial) + (export binomial) + (import (scheme base) (pingala factorial)) + (include "binomial-impl.scm")) diff --git a/tests/snow/repo3/pingala/factorial.scm b/tests/snow/repo3/pingala/factorial.scm new file mode 100644 index 00000000..8d61fd68 --- /dev/null +++ b/tests/snow/repo3/pingala/factorial.scm @@ -0,0 +1,7 @@ +(define-library (pingala factorial) + (export factorial) + (import (scheme base)) + (begin + (define (factorial n) + (let lp ((n n) (res 1)) + (if (<= n 1) res (lp (- n 1) (* res n))))))) diff --git a/tests/snow/repo3/pingala/test-map.scm b/tests/snow/repo3/pingala/test-map.scm new file mode 100644 index 00000000..e45c21b8 --- /dev/null +++ b/tests/snow/repo3/pingala/test-map.scm @@ -0,0 +1,18 @@ +(define-library (pingala test-map) + (export test-map test-exit) + (import (scheme base) (scheme process-context)) + (begin + (define failed? #f) + (define (test-exit) (exit (if failed? 1 0))) + (define-syntax test-map + (syntax-rules () + ((test-map expected proc values) + (let ((res (map proc 'values))) + (cond + ((not (equal? res 'expected)) + (set! failed? #t) + (display "FAIL: expected ") + (write 'expected) + (display " but got ") + (write res) + (newline))))))))) diff --git a/tests/snow/snow-tests.scm b/tests/snow/snow-tests.scm new file mode 100644 index 00000000..5e03a952 --- /dev/null +++ b/tests/snow/snow-tests.scm @@ -0,0 +1,136 @@ +(import (scheme base) (scheme write) (scheme process-context) (srfi 1) + (chibi ast) (chibi filesystem) (chibi match) (chibi pathname) + (chibi process) (chibi string) (chibi test)) + +(test-begin "snow") + +;; setup a temp root to install packages +(define install-prefix "tests/snow/tmp-root") +(define install-libdir (make-path install-prefix "/share/snow/chibi")) +(if (file-exists? install-prefix) + (delete-file-hierarchy install-prefix)) +(create-directory install-prefix) + +;; ignore any personal config settings +(setenv "SNOW_CHIBI_CONFIG" "no-such-file") + +;; run snow-chibi command as a separate process with test defaults +(define chibi-path "./chibi-scheme") +(define (snow-command . args) + `(,chibi-path "tools/snow-chibi" + --always-no + --implementations "chibi" + --chibi-path ,(string-append chibi-path " -A " install-libdir) + --install-prefix ,install-prefix + --local-user-repository "tests/snow/repo-cache" + ,@args)) + +(define-syntax snow + (syntax-rules () + ((snow args ...) + (match (process->output+error+status (apply snow-command `(args ...))) + ((output error (? zero?)) + ;;(display output) + ;;(display error) + ) + ((output error status) + (display "Snow failed:\n") + (display output) + (display error) + (newline)) + (other + (display "Snow error:\n") + (display other) + (newline)))))) + +(define-syntax snow->string + (syntax-rules () + ((snow->string args ...) + (process->string (apply snow-command `(args ...)))))) + +(define-syntax snow->sexp + (syntax-rules () + ((snow->sexp args ...) + (process->sexp (apply snow-command `(--sexp args ...)))))) + +(define (snow-status) + (snow->sexp status)) + +(define (installed-status status lib-name . o) + (let* ((impl (if (pair? o) (car o) 'chibi)) + (impl-status (assq impl status))) + (and impl-status + (assoc lib-name (cdr impl-status))))) + +(define (installed-version status lib-name . o) + (cond ((apply installed-status status lib-name o) => cadr) + (else #f))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; basics + +;; package +(snow package --output-dir tests/snow --authors "Édouard Lucas" + --description "Lucas recurrence relation" + tests/snow/repo0/edouard/lucas.sld) +(test-assert (file-exists? "tests/snow/edouard-lucas.tgz")) + +;; install +(snow install tests/snow/edouard-lucas.tgz) +(define lucas-sld-path + (make-path install-libdir "edouard/lucas.sld")) +(test-assert (file-exists? lucas-sld-path)) +(delete-file "tests/snow/edouard-lucas.tgz") + +;; status +(test-assert (installed-status (snow-status) '(edouard lucas))) + +;; remove +(snow remove edouard.lucas) +(test-not (file-exists? lucas-sld-path)) +(test-not (installed-version (snow-status) '(edouard lucas))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; install/upgrade via local repos + +(define repo1 '(--repository-uri tests/snow/repo1/repo.scm)) +(snow package --output-dir tests/snow/repo1/ + --version 1.0 --authors "Leonardo Fibonacci" + --description "Fibonacci recurrence relation" + tests/snow/repo1/leonardo/fibonacci.sld) +(snow index ,(cadr repo1) tests/snow/repo1/leonardo-fibonacci-1.0.tgz) +(snow ,@repo1 update) +(snow ,@repo1 install --show-tests leonardo.fibonacci) +(test "1.0" (installed-version (snow-status) '(leonardo fibonacci))) + +(define repo2 '(--repository-uri tests/snow/repo2/repo.scm)) +(snow package --output-dir tests/snow/repo2/ + --version 1.1 --authors "Leonardo Fibonacci" + --description "Fibonacci recurrence relation" + tests/snow/repo2/leonardo/fibonacci.sld) +(snow index ,(cadr repo2)) +(snow ,@repo2 update) +(snow ,@repo2 upgrade leonardo.fibonacci) +(test "1.1" (installed-version (snow-status) '(leonardo fibonacci))) + +(define repo3 '(--repository-uri tests/snow/repo3/repo.scm)) +(snow package --output-dir tests/snow/repo3/ + --version 1.0 --authors "Pingala" + --description "Factorial" + tests/snow/repo3/pingala/factorial.scm) +(snow package --output-dir tests/snow/repo3/ + --version 1.0 --authors "Pingala" + --description "Binomial Coefficients" + tests/snow/repo3/pingala/binomial.scm) +(snow package --output-dir tests/snow/repo3/ + --version 1.0 --authors "Pingala" + --description "Pingala's test framework" + tests/snow/repo3/pingala/test-map.scm) +(snow index ,(cadr repo3)) +(snow ,@repo3 update) +(snow ,@repo3 install pingala.binomial) +(let ((status (snow-status))) + (test-assert (installed-version status '(pingala binomial))) + (test-assert (installed-version status '(pingala factorial)))) + +(test-end)