committing @akeep library change with rebuilt boot files:

- fixed an issue with the library system where an exception that occurs during visit or revisit left the library in an inconsistent state that caused it to appear that it was still in the process of running. This manifested in it raising a cyclic dependency exception, even though there really is not a cyclic dependency. The various library management functions involved will now reset the part of the library when an exception occurs. This also means that if the library visit or revisit failed for a transient reason (such as a missing or incorrect library version that can be fixed by updating the library-directories) it is now possible to recover from these errors. expand-lang.ss, syntax.ss, interpret.ss, compile.ss, cprep.ss, 8.ms
cddwx525 · Apr 6, 2018 · 6dbd724 · 6dbd724
1 parent be022d9
commit 6dbd724
Show file tree

Hide file tree

Showing 32 changed files with 337 additions and 37 deletions.
diff --git a/LOG b/LOG
@@ -905,3 +905,15 @@
   field names in define-record-type field specs.
     syntax.ss,
     record.ms, root-experr*
+- fixed an issue with the library system where an exception that occurs
+  during visit or revisit left the library in an inconsistent state that
+  caused it to appear that it was still in the process of running.  This
+  manifested in it raising a cyclic dependency exception, even though
+  there really is not a cyclic dependency.  The various library
+  management functions involved will now reset the part of the library
+  when an exception occurs.  This also means that if the library visit
+  or revisit failed for a transient reason (such as a missing or
+  incorrect library version that can be fixed by updating the
+  library-directories) it is now possible to recover from these errors.
+    expand-lang.ss, syntax.ss, interpret.ss, compile.ss, cprep.ss,
+    8.ms
diff --git a/boot/a6le/petite.boot b/boot/a6le/petite.boot
diff --git a/boot/a6le/scheme.boot b/boot/a6le/scheme.boot
diff --git a/boot/a6nt/petite.boot b/boot/a6nt/petite.boot
diff --git a/boot/a6nt/scheme.boot b/boot/a6nt/scheme.boot
diff --git a/boot/a6osx/petite.boot b/boot/a6osx/petite.boot
diff --git a/boot/a6osx/scheme.boot b/boot/a6osx/scheme.boot
diff --git a/boot/i3le/petite.boot b/boot/i3le/petite.boot
diff --git a/boot/i3le/scheme.boot b/boot/i3le/scheme.boot
diff --git a/boot/i3nt/petite.boot b/boot/i3nt/petite.boot
diff --git a/boot/i3nt/scheme.boot b/boot/i3nt/scheme.boot
diff --git a/boot/i3osx/petite.boot b/boot/i3osx/petite.boot
diff --git a/boot/i3osx/scheme.boot b/boot/i3osx/scheme.boot
diff --git a/boot/ta6le/petite.boot b/boot/ta6le/petite.boot
diff --git a/boot/ta6le/scheme.boot b/boot/ta6le/scheme.boot
diff --git a/boot/ta6nt/petite.boot b/boot/ta6nt/petite.boot
diff --git a/boot/ta6nt/scheme.boot b/boot/ta6nt/scheme.boot
diff --git a/boot/ta6osx/petite.boot b/boot/ta6osx/petite.boot
diff --git a/boot/ta6osx/scheme.boot b/boot/ta6osx/scheme.boot
diff --git a/boot/ti3le/petite.boot b/boot/ti3le/petite.boot
diff --git a/boot/ti3le/scheme.boot b/boot/ti3le/scheme.boot
diff --git a/boot/ti3nt/petite.boot b/boot/ti3nt/petite.boot
diff --git a/boot/ti3nt/scheme.boot b/boot/ti3nt/scheme.boot
diff --git a/boot/ti3osx/petite.boot b/boot/ti3osx/petite.boot
diff --git a/boot/ti3osx/scheme.boot b/boot/ti3osx/scheme.boot
diff --git a/mats/8.ms b/mats/8.ms
@@ -8730,6 +8730,255 @@
     "revisiting testfile-l6-prog1\n#((10 . 12))\n")
 )
 
+(mat library-regression
+  ; test that failing invoke code does not result in cyclic dependency problem on re-run
+  (equal?
+    (separate-eval
+      '(begin
+         (library (invoke-fail)
+           (export x)
+           (import (chezscheme))
+           (define x #f)
+           (error #f "failed to load library (invoke-fail)"))
+         (guard (e [else
+                     (guard (e2 [else 
+                                  (display-condition e) (newline)
+                                  (display-condition e2) (newline)])
+                       (eval 'x (environment '(chezscheme) '(invoke-fail))))])
+           (eval 'x (environment '(chezscheme) '(invoke-fail))))))
+    "Exception: failed to load library (invoke-fail)\nException: failed to load library (invoke-fail)\n")
+
+  ; test that true cyclic dependency will always report the same thing
+  (equal?
+    (separate-eval
+      '(begin
+         (library (invoke-cyclic)
+           (export x y)
+           (import (chezscheme))
+           (define x #f)
+           (define y (eval '(if x 5 10) (environment '(chezscheme) '(invoke-cyclic)))))
+         (guard (e [else
+                     (guard (e2 [else 
+                                  (display-condition e) (newline)
+                                  (display-condition e2) (newline)])
+                       (eval 'x (environment '(chezscheme) '(invoke-cyclic))))])
+           (eval 'x  (environment '(chezscheme) '(invoke-cyclic))))))
+    "Exception: cyclic dependency involving invocation of library (invoke-cyclic)\nException: cyclic dependency involving invocation of library (invoke-cyclic)\n")
+
+  (begin
+    ; library to help make it easier to cause a failure in the visit-code that
+    ; does not lead to failure during compilation of the file.
+    (with-output-to-file "testfile-lr-l1.ss"
+      (lambda ()
+        (pretty-print
+          '(library (testfile-lr-l1)
+             (export make-it-fail)
+             (import (chezscheme))
+             (define make-it-fail (make-parameter #f (lambda (x) (and x #t)))))))
+      'replace)
+    ; simple test to define one macro and potentially to raise an error when
+    ; defining the second one.
+    (with-output-to-file "testfile-lr-l2.ss"
+      (lambda ()
+        (pretty-print
+          '(library (testfile-lr-l2)
+             (export M1 M2)
+             (import (chezscheme) (testfile-lr-l1))
+             (define-syntax M1
+               (identifier-syntax #f))
+
+             (define-syntax M2
+               (if (make-it-fail)
+                   (error 'M2 "user requested failure with (make-it-fail) parameter")
+                   (lambda (x)
+                     (syntax-case x ()
+                       [(_ expr) #'expr])))))))
+      'replace)
+    ; more complete test that attempts to create the various types of things
+    ; that can be defined in visit code so that we can verify things are being
+    ; properly reset.
+    (with-output-to-file "testfile-lr-l3.ss"
+      (lambda ()
+        (pretty-print
+          '(library (testfile-lr-l3)
+             (export a b c d e f g h)
+             (import (chezscheme) (testfile-lr-l1))
+
+             (module a (x) (define x 5))
+             (alias b cons)
+             (define-syntax c (make-compile-time-value 5))
+             (define d 5)
+             (meta define e 5)
+             (define-syntax f (identifier-syntax #f))
+             (define $g (make-parameter #f))
+             (define-syntax g
+               (make-variable-transformer
+                 (lambda (x)
+                   (syntax-case x ()
+                     [(set! _ v) #'($g v)]
+                     [_ #'($g)]
+                     [(_ e* ...) #'(($g) e* ...)]))))
+             (define-property f g 10)
+             (define-syntax h
+               (if (make-it-fail)
+                   (error 'h "user requested failure with (make-it-fail) parameter")
+                   (lambda (x)
+                     (syntax-case x ()
+                       [(_ expr) #'expr])))))))
+      'replace)
+    (separate-compile
+      '(lambda (x)
+         (parameterize ([compile-imported-libraries #t])
+           (for-each compile-library x)))
+      '(list "testfile-lr-l1" "testfile-lr-l2" "testfile-lr-l3"))
+    #t)
+
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l2) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval 'M1 (environment '(testfile-lr-l2))))])
+           (eval 'M1 (environment '(testfile-lr-l2))))))
+    "Exception in M2: user requested failure with (make-it-fail) parameter\nException in M2: user requested failure with (make-it-fail) parameter\n")
+
+  ; module is defined as part of import code, run time bindings are setup as part of invoke code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (import a)
+         x))
+    "5\n")
+
+  ; alias is part of module binding ribcage, set up by import code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (b 'a 'b)))
+    "(a . b)\n")
+
+  ; compile-time-value is set in visit code, should show same error each time it is referenced
+  (equal?
+    (separate-eval
+      '(begin
+         (library (lookup)
+           (export lookup)
+           (import (chezscheme))
+           (define-syntax lookup
+             (lambda (x)
+               (syntax-case x ()
+                 [(_ id) (lambda (rho) #`'#,(rho #'id))]
+                 [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))]))))
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup))))])
+           (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup))))))
+    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")
+
+  ; defines are set up as part of invoke code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         d))
+    "5\n")
+
+  ; meta defines are set up as part of visit code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval '(let ()
+                                (define-syntax get-e
+                                  (lambda (x)
+                                    (syntax-case x ()
+                                      [(_) #`'#,e])))
+                                (get-e))
+                         (environment '(chezscheme) '(testfile-lr-l3))))])
+           (eval '(let ()
+                    (define-syntax get-e
+                      (lambda (x)
+                        (syntax-case x ()
+                          [(_) #`'#,e])))
+                    (get-e))
+             (environment '(chezscheme) '(testfile-lr-l3))))))
+    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")
+
+  ; macros are set up as part of visit code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval 'f (environment '(testfile-lr-l3))))])
+           (eval 'f (environment '(testfile-lr-l3))))))
+    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")
+
+  ; variable transformer macros are set up as part of visit code
+  (equal?
+    (separate-eval
+      '(begin
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval 'g (environment '(testfile-lr-l3))))])
+           (eval 'g (environment '(testfile-lr-l3))))))
+    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")
+
+  ; properties are setup as part of visit code.
+  (equal?
+    (separate-eval
+      '(begin
+         (library (lookup)
+           (export lookup)
+           (import (chezscheme))
+           (define-syntax lookup
+             (lambda (x)
+               (syntax-case x ()
+                 [(_ id) (lambda (rho) #`'#,(rho #'id))]
+                 [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))]))))
+         (import (testfile-lr-l3) (testfile-lr-l1))
+         (make-it-fail #t)
+         (guard (e [else
+                     (guard (e2
+                              [else
+                                (display-condition e) (newline)
+                                (display-condition e2) (newline)])
+                       (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup))))])
+           (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup))))))
+    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")
+)
+
 (mat cross-library-optimization
   (begin
     (with-output-to-file "testfile-clo-1a.ss"

diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
@@ -1566,13 +1566,24 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
-\subsection{Incomplete handling of import specs within standalone export forms}
+\subsection{Misleading cyclic dependency error (9.5)}
+
+The library system no longer reports a cyclic dependency error
+during the second and subsequent attempts to visit or invoke a
+library after the first attempt fails for some reason other than
+an actual cyclic dependency.
+The fix also allows a library to be visited or invoked successfully
+on the second or subsequent attempt if the visit or invoke failed
+for a transient reason, such as a missing or incorrect version in
+an imported library.
+
+\subsection{Incomplete handling of import specs within standalone export forms (9.5)}
 
 A bug that limited the \scheme{(import \var{import-spec} \dots)} form within a
 standalone \scheme{export} form to \scheme{(import \var{import-spec})} has been
 fixed.
 
-\subsection{Permission denied after deleting files or directories in Windows}
+\subsection{Permission denied after deleting files or directories in Windows (9.5)}
 
 In Windows, deleting a file or directory briefly leaves the file or
 directory in a state where a subsequent create operation fails with

diff --git a/s/compile.ss b/s/compile.ss
@@ -461,8 +461,8 @@
       (Inner : Inner (ir) -> Inner ()
         [,lsrc lsrc] ; NB: workaround for nanopass tag snafu
         [(program ,uid ,body) ($build-invoke-program uid body)]
-        [(library/ct ,uid  ,import-code ,visit-code)
-         ($build-install-library/ct-code uid import-code visit-code)]
+        [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
+         ($build-install-library/ct-code uid export-id* import-code visit-code)]
         [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body)
          ($build-install-library/rt-code uid dl* db* dv* de* body)]
         [else ir]))
@@ -916,7 +916,7 @@
                    (program-node-ir-set! maybe-program ir)
                    (values)])
                 (ctLibrary : ctLibrary (ir situation) -> * ()
-                  [(library/ct ,uid ,import-code ,visit-code)
+                  [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
                    (when (eq? situation 'revisit) ($oops who "encountered revisit-only compile-time library ~s while processing wpo file ~s" (lookup-path uid) ifn))
                    (record-ct-lib-ir! uid ir)
                    (values)])
@@ -1042,8 +1042,8 @@
     (define build-install-library/ct-code
       (lambda (node)
         (nanopass-case (Lexpand ctLibrary) (library-node-ctir node)
-          [(library/ct ,uid ,import-code ,visit-code)
-           ($build-install-library/ct-code uid
+          [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
+           ($build-install-library/ct-code uid export-id*
              (if (library-node-visible? node) import-code void-pr)
              (if (library-node-visible? node) visit-code void-pr))])))
 
@@ -1449,8 +1449,8 @@
          (Inner : Inner (ir) -> Expr ()
            [,lsrc lsrc]
            [(program ,uid ,body) ($build-invoke-program uid body)]
-           [(library/ct ,uid ,import-code ,visit-code)
-            ($build-install-library/ct-code uid import-code visit-code)]
+           [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
+            ($build-install-library/ct-code uid export-id* import-code visit-code)]
            [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body)
             ($build-install-library/rt-code uid dl* db* dv* de* body)]
            [else (sorry! who "unexpected Lexpand record ~s" ir)])

diff --git a/s/cprep.ss b/s/cprep.ss
@@ -26,8 +26,8 @@
         (Inner : Inner (ir) -> * (val)
           [,lsrc (go lsrc)]
           [(program ,uid ,body) (go ($build-invoke-program uid body))]
-          [(library/ct ,uid ,import-code ,visit-code)
-           (go ($build-install-library/ct-code uid import-code visit-code))]
+          [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
+           (go ($build-install-library/ct-code uid export-id* import-code visit-code))]
           [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body)
            (go ($build-install-library/rt-code uid dl* db* dv* de* body))]
           [,linfo/ct `(library/ct-info ,(library-info-uid linfo/ct) ,(library/ct-info-import-req* linfo/ct)

diff --git a/s/expand-lang.ss b/s/expand-lang.ss
@@ -80,10 +80,10 @@
   (define maybe-label? (lambda (x) (or (not x) (gensym? x))))
 
   (define-language Lexpand
-    (nongenerative-id #{Lexpand fgy7v2wrvj0so4ro8kvhqo-1})
+    (nongenerative-id #{Lexpand fgy7v2wrvj0so4ro8kvhqo-2})
     (terminals
       (maybe-label (dl))
-      (gensym (uid))
+      (gensym (uid export-id))
       (library-path (path))
       (library-version (version))
       (maybe-optimization-loc (db))
@@ -110,7 +110,7 @@
       prog
       lsrc)
     (ctLibrary (ctlib)
-      (library/ct uid import-code visit-code))
+      (library/ct uid (export-id* ...) import-code visit-code))
     (rtLibrary (rtlib)
       (library/rt uid
         (dl* ...)

diff --git a/s/interpret.ss b/s/interpret.ss
@@ -666,8 +666,8 @@
     [,lsrc (ibeval lsrc)]
     [(program ,uid ,body)
      (ibeval ($build-invoke-program uid body))]
-    [(library/ct ,uid ,import-code ,visit-code)
-     (ibeval ($build-install-library/ct-code uid import-code visit-code))]
+    [(library/ct ,uid (,export-id* ...) ,import-code ,visit-code)
+     (ibeval ($build-install-library/ct-code uid export-id* import-code visit-code))]
     [(library/rt ,uid (,dl* ...) (,db* ...) (,dv* ...) (,de* ...) ,body)
      (ibeval ($build-install-library/rt-code uid dl* db* dv* de* body))]
     [,linfo/rt ($install-library/rt-desc linfo/rt for-import? ofn)]