chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH 3/3] Fix repository searching for "-link" flag


From: Evan Hanson
Subject: [Chicken-hackers] [PATCH 3/3] Fix repository searching for "-link" flag and associated tests
Date: Tue, 20 Jun 2017 21:51:57 +1200

The part of the linking tests that was supposed to make sure the "-link"
flag picks up object files from the repository was broken, since the
reverser.o file that should have been *moved* into the test repository
was *copied* there. This meant that a reverser.o was left in the current
directory, and the test picked that one up instead of the one from the
repo.

Fixing this uncovered the fact that the behaviour it was meant to test
was broken, so this patch also fixes that by updating the
`find-object-file` procedure in csc.scm to use the same lookup logic
that `##sys#process-require` uses for static extensions. It also
standardises the naming of the two procedures used to look up files for
extensions, uses internal namespacing to share them between files, and
fixes the indentation of the `find-static-extension` procedure (née
`static-extension-available?`) in eval.scm.

Also, use "rmdir" to make sure the test repository is always deleted
before running the test suite on Windows.
---
 batch-driver.scm   |  2 +-
 csc.scm            |  8 +++-----
 eval.scm           | 28 ++++++++++++++++------------
 modules.scm        |  2 +-
 tests/runtests.bat | 10 +++++-----
 tests/runtests.sh  |  2 +-
 6 files changed, 27 insertions(+), 25 deletions(-)

diff --git a/batch-driver.scm b/batch-driver.scm
index 45bea523..66f5c803 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -601,7 +601,7 @@
                      import-libraries) ", ")))
 
             (and-let* ((reqs (hash-table-ref file-requirements 'dynamic))
-                       (missing (remove (cut ##sys#find-extension <> #f) 
reqs)))
+                       (missing (remove (cut 
chicken.load#find-dynamic-extension <> #f) reqs)))
               (when (null? (lset-intersection/eq? '(eval repl) used-units))
                 (notice ; XXX only issued when "-verbose" is used
                  (sprintf "~A has dynamic requirements but doesn't load 
(chicken eval): ~A"
diff --git a/csc.scm b/csc.scm
index affa02e5..e3d369fe 100644
--- a/csc.scm
+++ b/csc.scm
@@ -284,12 +284,10 @@
 ;;; Locate object files for linking:
 
 (define (find-object-file name)
-  (or (file-exists? (make-pathname #f name object-extension))
+  (or (parameterize ((repository-path "."))
+       (chicken.load#find-static-extension name))
       (and (not ignore-repository)
-           (file-exists? (make-pathname (destination-repository (if host-mode
-                                                                    'host
-                                                                    'target))
-                                        name object-extension)))
+          (chicken.load#find-static-extension name))
       (stop "could not find linked extension: ~a" name)))
 
 
diff --git a/eval.scm b/eval.scm
index 2c62136e..84d7bd4f 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1234,7 +1234,7 @@
                 (set! cache (cons path lst))
                 lst))))))
 
-(define ##sys#find-extension
+(define find-dynamic-extension
   (let ((file-exists? file-exists?)
        (string-append string-append))
     (lambda (path inc?)
@@ -1262,7 +1262,7 @@
        ((any ##sys#provided? alternates))
        ((memq id core-units)
          (load-library/internal id #f loc))
-       ((##sys#find-extension id #f) =>
+       ((find-dynamic-extension id #f) =>
         (lambda (ext)
           (load/internal ext #f #f #f #f id)
           (##sys#provide id)))
@@ -1289,18 +1289,22 @@
   (for-each (cut ##sys#check-symbol <> 'provided?) ids)
   (every ##sys#provided? ids))
 
-(define static-extension-available?
+(define find-static-extension
   (let ((string-append string-append))
     (lambda (id)
       (and-let* ((rp (repository-path)))
-           (let loop ((rp (##sys#split-path rp)))
-             (cond ((null? rp) #f)
-                   ((file-exists? 
-                      (string-append (car rp) "/" 
-                                     (##sys#canonicalize-extension-path id #f)
-                                     object-file-extension)))
-                   (else (loop (cdr rp)))))))))
-
+       (let loop ((rp (##sys#split-path rp)))
+         (cond ((null? rp) #f)
+               ((file-exists?
+                 (string-append
+                  (car rp) "/"
+                  (##sys#canonicalize-extension-path id #f)
+                  object-file-extension)))
+               (else (loop (cdr rp)))))))))
+
+;; Export for internal use in csc, modules and batch-driver:
+(define chicken.load#find-static-extension find-static-extension)
+(define chicken.load#find-dynamic-extension find-dynamic-extension)
 
 ;;
 ;; Given a library specification, returns three values:
@@ -1326,7 +1330,7 @@
            `(##core#declare (uses ,id))
            `(##sys#load-library (##core#quote ,id)))
        id #f))
-      ((and compiling? static? (static-extension-available? id)) =>
+      ((and compiling? static? (find-static-extension id)) =>
        (lambda (path) 
          (mark-static id path)
          (values `(##core#declare (uses ,id)) id 'static)))
diff --git a/modules.scm b/modules.scm
index 637eda0c..c38d9810 100644
--- a/modules.scm
+++ b/modules.scm
@@ -567,7 +567,7 @@
   (let* ((mname (##sys#resolve-module-name lib loc))
         (mod (##sys#find-module mname #f loc)))
     (unless mod
-      (and-let* ((il (##sys#find-extension
+      (and-let* ((il (chicken.load#find-dynamic-extension
                      (string-append (symbol->string mname) ".import")
                      #t)))
        (parameterize ((##sys#current-module #f)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 8eb5fea8..c56638e3 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -9,7 +9,7 @@ set CHICKEN=..\chicken
 set CHICKEN_PROFILE=..\chicken-profile
 set CHICKEN_INSTALL_REPOSITORY=%TEST_DIR%\test-repository
 set CHICKEN_REPOSITORY_PATH=%TEST_DIR%\..;%CHICKEN_INSTALL_REPOSITORY%
-set PATH=%cd%\..;%PATH%
+set PATH=%TEST_DIR%\..;%PATH%
 
 set TYPESDB=..\types.db
 rem Increase this when tests start failing on "inexplicable" diffs
@@ -20,9 +20,10 @@ set compile2=..\csc -compiler %CHICKEN% -v -I%TEST_DIR%/.. 
-L%TEST_DIR%/.. -incl
 set compile_s=..\csc -s -types %TYPESDB% -ignore-repository -compiler 
%CHICKEN% -v -I%TEST_DIR%/.. -L%TEST_DIR%/.. -include-path %TEST_DIR%/..
 set interpret=..\csi -n -include-path %TEST_DIR%/..
 
-del /f /q /s *.exe *.so *.o *.import.* ..\foo.import.* test-repository
-mkdir test-repository
-copy %TYPESDB% test-repository
+del /f /q /s *.exe *.so *.o *.import.* ..\foo.import.* 
%CHICKEN_INSTALL_REPOSITORY%
+rmdir /q /s %CHICKEN_INSTALL_REPOSITORY%
+mkdir %CHICKEN_INSTALL_REPOSITORY%
+copy %TYPESDB% %CHICKEN_INSTALL_REPOSITORY%
 
 echo ======================================== version tests ...
 %compile% version-tests.scm
@@ -574,7 +575,6 @@ if errorlevel 1 exit /b 1
 if errorlevel 1 exit /b 1
 linking-tests
 if errorlevel 1 exit /b 1
-mkdir %CHICKEN_INSTALL_REPOSITORY%
 move reverser.o %CHICKEN_INSTALL_REPOSITORY%
 move reverser.import.scm %CHICKEN_INSTALL_REPOSITORY%
 %compile2% -link reverser linking-tests.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 7c7507d5..cae5f961 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -444,7 +444,7 @@ $compile2 -link reverser linking-tests.scm
 ./linking-tests
 $compile2 -link reverser linking-tests.scm -static
 ./linking-tests
-cp reverser.o reverser.import.scm "$CHICKEN_INSTALL_REPOSITORY"
+mv reverser.o reverser.import.scm "$CHICKEN_INSTALL_REPOSITORY"
 $compile2 -link reverser linking-tests.scm
 ./linking-tests
 $compile2 -link reverser linking-tests.scm -static
-- 
2.11.0




reply via email to

[Prev in Thread] Current Thread [Next in Thread]