added missing Inner wrappers around the library/ct-info and

library-rt-info records in the code for compile-whole-xxx. compile.ss, 7.ms
gongchengra · Oct 4, 2019 · 2e6e0e1 · 2e6e0e1
1 parent 9828528
commit 2e6e0e1
Show file tree

Hide file tree

Showing 3 changed files with 44 additions and 23 deletions.
diff --git a/LOG b/LOG
@@ -1761,3 +1761,7 @@
     compile.ss
 - initialized variable to enable compilation with gcc 9.1.0 at -O3
     c/scheme.c
+- added missing Inner wrappers around the library/ct-info and
+  library-rt-info records in the code for compile-whole-xxx.
+    compile.ss,
+    7.ms
diff --git a/mats/7.ms b/mats/7.ms
@@ -3891,6 +3891,21 @@ evaluating module init
         (delete-file (format "testfile-deja-vu-~a.~a" (car stem) (car ext)))))
     #t)
 
+  ; verify compatibility of generate-covin-files and generate-wpo-files
+  (begin
+    (mkfile "testfile-cwl-a14.ss"
+      '(library (testfile-cwl-a14) (export a) (import (scheme)) (define a 123)))
+    (parameterize ([generate-covin-files #t]
+                   [generate-wpo-files #t])
+      (compile-library "testfile-cwl-a14")
+      (compile-whole-library "testfile-cwl-a14.wpo" "testfile-cwl-a14.library"))
+    #t)
+
+  (file-exists? "testfile-cwl-a14.covin")
+
+  (eqv?
+    (let () (import (testfile-cwl-a14)) a)
+    123)
 )
 
 (mat maybe-compile-whole

diff --git a/s/compile.ss b/s/compile.ss
@@ -1406,13 +1406,14 @@
                 (let* ([info (library-node-rtinfo node)]
                        [uid (library-info-uid info)])
                   `(group (revisit-only
-                            ,(make-library/rt-info
-                               (library-info-path info)
-                               (library-info-version info)
-                               uid
-                               (requirements-join
-                                 (library/rt-info-invoke-req* info)
-                                 (and maybe-ht (symbol-hashtable-ref maybe-ht uid #f)))))
+                            (library/ct-info
+                              ,(make-library/rt-info
+                                 (library-info-path info)
+                                 (library-info-version info)
+                                 uid
+                                 (requirements-join
+                                   (library/rt-info-invoke-req* info)
+                                   (and maybe-ht (symbol-hashtable-ref maybe-ht uid #f))))))
                      ,body))))
           body node*)))
 
@@ -1422,22 +1423,23 @@
           (lambda (body visit-lib)
             (if (library-node-binary? visit-lib)
                 body
-                `(group (visit-only
-                          ,(let* ([info (library-node-ctinfo visit-lib)]
-                                  [uid (library-info-uid info)])
-                             (make-library/ct-info
-                               (library-info-path info)
-                               (library-info-version info)
-                               uid
-                               (requirements-join
-                                 (library/ct-info-import-req* info)
-                                 (and maybe-ht (symbol-hashtable-ref maybe-ht uid #f)))
-                               (library/ct-info-visit-visit-req* info)
-                               (library/ct-info-visit-req* info)
-                               (if (library-node-visible? visit-lib)
-                                   (library/ct-info-clo* info)
-                                   '()))))
-                   ,body)))
+                (let* ([info (library-node-ctinfo visit-lib)]
+                       [uid (library-info-uid info)])
+                  `(group (visit-only
+                            (library/ct-info
+                              ,(make-library/ct-info
+                                 (library-info-path info)
+                                 (library-info-version info)
+                                 uid
+                                 (requirements-join
+                                   (library/ct-info-import-req* info)
+                                   (and maybe-ht (symbol-hashtable-ref maybe-ht uid #f)))
+                                 (library/ct-info-visit-visit-req* info)
+                                 (library/ct-info-visit-req* info)
+                                 (if (library-node-visible? visit-lib)
+                                     (library/ct-info-clo* info)
+                                     '()))))
+                     ,body))))
           body visit-lib*)))
 
     (define add-visit-lib-install*