diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index d4e0a900..415d6242 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -1422,7 +1422,8 @@ (define (default-installer impl cfg library dir) (let* ((library-file (get-library-file cfg library)) (ext (get-library-extension impl cfg)) - (dest-library-file (path-replace-extension library-file ext)) + (dest-library-file + (string-append (library->path cfg library) "." ext)) (include-files (library-include-files impl cfg (make-path dir library-file))) (install-dir (get-install-source-dir impl cfg))) @@ -1482,7 +1483,10 @@ (ext (get-library-extension impl cfg)) (src-library-file (make-path dir library-file)) (library-dir (path-directory src-library-file)) - (dest-library-file (path-replace-extension library-file ext)) + (dest-library-file + (string-append (library->path cfg library) "." ext)) + (dest-dir + (path-directory (make-path dir dest-library-file))) (include-files (library-include-files impl cfg (make-path dir library-file))) (rewrite-include-files @@ -1502,13 +1506,25 @@ (list (path-relative-to (car x) library-dir) (path-relative-to (cadr x) library-dir))) rewrite-include-files))) - ;; rename + ;; ensure the build directory exists + (create-directory* dest-dir) + ;; rename or copy includes (for-each (lambda (x) (rename-file (car x) (cadr x))) rewrite-include-files) + (for-each + (lambda (x) + (let ((dest-file (make-path dest-dir (path-relative x library-dir)))) + (install-directory cfg (path-directory dest-file)) + (install-file cfg x dest-file) + dest-file)) + (filter (lambda (f) (not (equal? f dest-library-file))) include-files)) + ;; install the library declaration file (cond ((pair? rewrite-include-files) + ;; If we needed to rename an include file, we also need to rewrite + ;; the library declaration itself to point to the new location. ;; TODO: rewrite with a structural editor to preserve formatting (let ((library (library-rewrite-includes diff --git a/tests/snow/repo3/totient-impl.scm b/tests/snow/repo3/totient-impl.scm new file mode 100644 index 00000000..7ace8193 --- /dev/null +++ b/tests/snow/repo3/totient-impl.scm @@ -0,0 +1,12 @@ +(define (totient n) + (let ((limit (exact (ceiling (sqrt n))))) + (let lp ((i 2) (count 1)) + (cond ((> i limit) + (if (= count (- i 1)) + (- n 1) ; shortcut for prime + (let lp ((i i) (count count)) + (cond ((>= i n) count) + ((= 1 (gcd n i)) (lp (+ i 1) (+ count 1))) + (else (lp (+ i 1) count)))))) + ((= 1 (gcd n i)) (lp (+ i 1) (+ count 1))) + (else (lp (+ i 1) count)))))) diff --git a/tests/snow/repo3/totient-test.scm b/tests/snow/repo3/totient-test.scm new file mode 100644 index 00000000..c4586d82 --- /dev/null +++ b/tests/snow/repo3/totient-test.scm @@ -0,0 +1,26 @@ + +(import (scheme base) (scheme write) (scheme process-context) (euler totient)) + +(define-syntax test + (syntax-rules () + ((test expect expr) + (let ((res expr)) + (unless (equal? expect res) + (display "FAIL: ") + (write 'expr) + (display " - expected ") + (write expect) + (display " but got ") + (write res) + (newline) + (exit 1)))))) + +(test 1 (totient 2)) +(test 2 (totient 3)) +(test 2 (totient 4)) +(test 4 (totient 5)) +(test 2 (totient 6)) +(test 6 (totient 7)) +(test 4 (totient 8)) +(test 6 (totient 9)) +(test 4 (totient 10)) diff --git a/tests/snow/repo3/totient.scm b/tests/snow/repo3/totient.scm new file mode 100644 index 00000000..921cd634 --- /dev/null +++ b/tests/snow/repo3/totient.scm @@ -0,0 +1,4 @@ +(define-library (euler totient) + (export totient) + (import (scheme base) (scheme inexact)) + (include "totient-impl.scm")) diff --git a/tests/snow/snow-tests.scm b/tests/snow/snow-tests.scm index 20623fb0..600036e2 100644 --- a/tests/snow/snow-tests.scm +++ b/tests/snow/snow-tests.scm @@ -180,6 +180,11 @@ --description "Equality implementation" --test-library "tests/snow/repo3/recorde/equal-test.sld" tests/snow/repo3/recorde/equal.sld) +(snow package --output-dir tests/snow/repo3/ + --version "2.7.1" --authors "Leonhard Euler" + --description "Euler's Totient function" + --test "tests/snow/repo3/totient-test.scm" + tests/snow/repo3/totient.scm) (snow package --output-dir tests/snow/repo3/ --version 1.0 --authors "Pythagoras" --description "Pythagoran Theorem" @@ -188,9 +193,11 @@ (snow index ,(cadr repo3)) (snow ,@repo3 update) (snow ,@repo3 install pingala.binomial) +(snow ,@repo3 install euler.totient) (let ((status (snow-status))) (test-assert (installed-version status '(pingala binomial))) - (test-assert (installed-version status '(pingala factorial)))) + (test-assert (installed-version status '(pingala factorial))) + (test "2.7.1" (installed-version status '(euler totient)))) ;; programs (snow ,@repo3 install pingala.triangle)