Fixing installs of packages with library files not matching their names.

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

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))))))

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))

tests/snow/repo3/totient.scm

@@ -0,0 +1,4 @@
+(define-library (euler totient)
+  (export totient)
+  (import (scheme base) (scheme inexact))
+  (include "totient-impl.scm"))

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)