Make sure that jscl can only load files generated with the same version

Author: davazp

src/boot.lisp

@@ -45,7 +45,7 @@
                      (%compile-defmacro ',name ,expander))
 
                   )))))
-    
+
     (%compile-defmacro 'defmacro defmacro-macroexpander)))
 
 (defmacro backquote (form)
@@ -462,7 +462,7 @@
       ;; todo: subtypep - remove mop-object from tables
       (clos-object . mop-object-p) (mop-object . mop-object-p) (character . characterp)
       (symbol . symbolp)  (keyword . keywordp)
-      (function . functionp) 
+      (function . functionp)
       (number . numberp) (real . realp) (rational . rationalp) (float . floatp)
       (integer . integerp)
       (sequence .  sequencep) (list . listp) (cons . consp) (array . arrayp)
@@ -537,7 +537,7 @@
 
 
 #+jscl-target
-(defmacro print-unreadable-object ((object stream &key type identity) &body body) 
+(defmacro print-unreadable-object ((object stream &key type identity) &body body)
     `(!print-unreadable-object (,object ,stream :type ,type :identity ,identity) ,@body))
 
 
@@ -613,4 +613,6 @@
            object)
           (t (fail)))))
 
+(defvar *git-commit-hash* #.(get-current-git-commit))
+
 ;;; EOF

src/compile-file.lisp

@@ -65,5 +65,6 @@ typeof window !== 'undefined'? window.jscl: self.jscl )"
 (function(internals){ var values = internals.values;" out)
     (with-compilation-environment
       (!compile-file input-file out :verbose verbose :print print))
-    (write-string "})(jscl.internals);};" out))
+    (write-string "})(jscl.internals);};" out)
+    (format out "module.exports.jsclVersion = ~S;" *git-commit-hash*))
   output-file)

src/load.lisp

@@ -56,6 +56,13 @@
        (let ((*package* *package*))
          (if (find :node *features*)
              (let ((init (require (concat (clstring (#j:process:cwd)) "/" name))))
+               (let ((file-version (oget init "jsclVersion")))
+                 (when (or (eq (typeof file-version) #j"undefined")
+                           (not (string= (clstring file-version) *git-commit-hash*)))
+                   (error "Cannot load ~a: compiled with JSCL ~a but current is ~a"
+                          name
+                          (if (eq (typeof file-version) #j"undefined") "unknown" (clstring file-version))
+                          *git-commit-hash*)))
                (funcall init (%js-vref "jscl")))
              (load-js name)))
        t)

tests.lisp

@@ -130,13 +130,15 @@
         (let ((entry (jscl/ffi:clstring (aref entries i))))
           (when (and (> (length entry) 5)
                      (string= (subseq entry (- (length entry) 5)) ".lisp")
-                     (not (search ".fixtures." entry)))
+                     (not (search ".fixtures." entry))
+                     (not (string= entry "helpers.lisp")))
             (push (concatenate 'string "tests/" entry) files)))))
     (push "tests/loop/validate.lisp" files)
     (push "tests/loop/base-tests.lisp" files)
     (nreverse files))
   #-jscl
-  (append (remove-if (lambda (p) (search ".fixtures." (namestring p)))
+  (append (remove-if (lambda (p) (or (search ".fixtures." (namestring p))
+                                     (search "helpers.lisp" (namestring p))))
                      (directory (make-pathname :directory `(:relative "tests") :name :wild :type "lisp" :defaults *load-pathname*)))
           (list (make-pathname :directory `(:relative "tests" "loop") :name "validate" :type "lisp" :defaults *load-pathname*)
                 (make-pathname :directory `(:relative "tests" "loop") :name "base-tests" :type "lisp" :defaults *load-pathname*))))
@@ -163,6 +165,9 @@ In SBCL, test files are loaded directly."
       ;; Start timing after compilation
       (setq *timestamp* (get-internal-real-time))
       (terpri)
+      ;; Load shared test helpers
+      (load #+jscl "tests/helpers.lisp"
+            #-jscl (make-pathname :directory '(:relative "tests") :name "helpers" :type "lisp" :defaults *load-pathname*))
       ;; Load test files (tests execute immediately via test macro)
       (dolist (file files-to-load)
         (handler-case

tests/compile-file.lisp

@@ -0,0 +1,29 @@
+;;; compile-file.lisp --- Tests for compile-file
+
+(in-package :jscl-tests)
+
+;;; Version checking (JSCL + Node.js only)
+#+jscl
+(when (find :node *features*)
+  (let ((wrong-version-file (make-test-tmp-file "version-wrong.js"))
+        (correct-version-file (make-test-tmp-file "version-correct.js"))
+        (no-version-file (make-test-tmp-file "version-none.js")))
+
+    ;; File with wrong jsclVersion should fail to load
+    (with-open-file (out wrong-version-file :direction :output :if-exists :supersede)
+      (write-string "module.exports = function(jscl){};" out)
+      (write-string "module.exports.jsclVersion = \"wrong-version\";" out))
+    (test (handler-case (progn (load wrong-version-file) nil)
+            (error () t)))
+
+    ;; File with correct jsclVersion should load successfully
+    (with-open-file (out correct-version-file :direction :output :if-exists :supersede)
+      (write-string "module.exports = function(jscl){};" out)
+      (format out "module.exports.jsclVersion = ~S;" jscl::*git-commit-hash*))
+    (test (load correct-version-file))
+
+    ;; File without jsclVersion should fail to load
+    (with-open-file (out no-version-file :direction :output :if-exists :supersede)
+      (write-string "module.exports = function(jscl){};" out))
+    (test (handler-case (progn (load no-version-file) nil)
+            (error () t)))))

tests/file.lisp

@@ -2,19 +2,15 @@
 
 #+node
 (progn
-  (let ((fs (require "fs")))
-    ((jscl/ffi:oget fs "mkdirSync") #j".jscl_test" (jscl/ffi:object "recursive" #j:true))
-    (defvar *tmp-dir* (jscl/ffi:clstring ((jscl/ffi:oget fs "mkdtempSync") #j".jscl_test/test-"))))
-
   (test
    (progn
-     (with-open-file (s (concatenate 'string *tmp-dir* "/file-1.txt")
+     (with-open-file (s (make-test-tmp-file "file-1.txt")
                         :direction :output :if-exists :supersede)
        (write-line "abc" s)
        (write-line "foo" s))
-     (with-open-file (s (concatenate 'string *tmp-dir* "/file-1.txt"))
+     (with-open-file (s (make-test-tmp-file "file-1.txt"))
        (and (equal (read-line s nil) "abc")
             (equal (read-line s nil) "foo")
             (equal (read-line s nil) nil)))))
 
-  (test (probe-file (concatenate 'string *tmp-dir* "/file-1.txt"))))
+  (test (probe-file (make-test-tmp-file "file-1.txt"))))