Fix native compiler string hash consing strategy (bug#47868)

	* test/src/comp-tests.el (comp-test-47868-1): Add new test.
	* test/src/comp-test-funcs.el (comp-test-47868-1-f)
	(comp-test-47868-2-f): New functions.
	* lisp/emacs-lisp/comp.el (comp-imm-equal-test): Define new hash
	tanble test.
	(comp-data-container): Use it.
	(comp-final, comp-run-async-workers): have comp required before
	reading dumped hashes so that `comp-imm-equal-test' is defined.

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0122008fc9e361b761f819580b868da8170daf4e..394b8cb73c09da464187ea713c225f36da89795f 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -730,11 +730,15 @@ Returns ELT."
             finally return h)
     "Hash table lap-op -> stack adjustment."))
 
+(define-hash-table-test 'comp-imm-equal-test #'equal-including-properties
+  (lambda (x)
+    (sxhash-equal-including-properties x)))
+
 (cl-defstruct comp-data-container
   "Data relocation container structure."
   (l () :type list
      :documentation "Constant objects used by functions.")
-  (idx (make-hash-table :test #'equal) :type hash-table
+  (idx (make-hash-table :test 'comp-imm-equal-test) :type hash-table
        :documentation "Obj -> position into the previous field."))
 
 (cl-defstruct (comp-ctxt (:include comp-cstr-ctxt))
@@ -3648,25 +3652,26 @@ Prepare every function for final compilation and drive the C back-end."
              (print-gensym t)
              (print-circle t)
              (print-escape-multibyte t)
-             (expr `(progn
-                      (require 'comp)
-                      (setf comp-verbose ,comp-verbose
-                            comp-libgccjit-reproducer ,comp-libgccjit-reproducer
-                            comp-ctxt ,comp-ctxt
-                            comp-eln-load-path ',comp-eln-load-path
-                            comp-native-driver-options
-                            ',comp-native-driver-options
-                            load-path ',load-path)
-                      ,comp-async-env-modifier-form
-                      (message "Compiling %s..." ',output)
-                      (comp-final1)))
+             (expr `((require 'comp)
+                     (setf comp-verbose ,comp-verbose
+                           comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+                           comp-ctxt ,comp-ctxt
+                           comp-eln-load-path ',comp-eln-load-path
+                           comp-native-driver-options
+                           ',comp-native-driver-options
+                           load-path ',load-path)
+                     ,comp-async-env-modifier-form
+                     (message "Compiling %s..." ',output)
+                     (comp-final1)))
              (temp-file (make-temp-file
                         (concat "emacs-int-comp-"
                                 (file-name-base output) "-")
                         nil ".el")))
        (with-temp-file temp-file
           (insert ";; -*-coding: nil; -*-\n")
-          (insert (prin1-to-string expr)))
+          (mapc (lambda (e)
+                  (insert (prin1-to-string e)))
+                expr))
        (with-temp-buffer
           (unwind-protect
               (if (zerop
@@ -3900,34 +3905,33 @@ display a message."
                        ; commanded for late load.
                   (file-newer-than-file-p
                    source-file (comp-el-to-eln-filename source-file)))
-         do (let* ((expr `(progn
-                            (require 'comp)
-                            ,(when (boundp 'backtrace-line-length)
-                               `(setf backtrace-line-length ,backtrace-line-length))
-                            (setf comp-speed ,comp-speed
-                                  comp-debug ,comp-debug
-                                  comp-verbose ,comp-verbose
-                                  comp-libgccjit-reproducer ,comp-libgccjit-reproducer
-                                  comp-async-compilation t
-                                  comp-eln-load-path ',comp-eln-load-path
-                                  comp-native-driver-options
-                                  ',comp-native-driver-options
-                                  load-path ',load-path
-                                  warning-fill-column most-positive-fixnum)
-                            ,comp-async-env-modifier-form
-                            (message "Compiling %s..." ,source-file)
-                            (comp--native-compile ,source-file ,(and load t))))
+         do (let* ((expr `((require 'comp)
+                           ,(when (boundp 'backtrace-line-length)
+                              `(setf backtrace-line-length ,backtrace-line-length))
+                           (setf comp-speed ,comp-speed
+                                 comp-debug ,comp-debug
+                                 comp-verbose ,comp-verbose
+                                 comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+                                 comp-async-compilation t
+                                 comp-eln-load-path ',comp-eln-load-path
+                                 comp-native-driver-options
+                                 ',comp-native-driver-options
+                                 load-path ',load-path
+                                 warning-fill-column most-positive-fixnum)
+                           ,comp-async-env-modifier-form
+                           (message "Compiling %s..." ,source-file)
+                           (comp--native-compile ,source-file ,(and load t))))
                    (source-file1 source-file) ;; Make the closure works :/
                    (temp-file (make-temp-file
                                (concat "emacs-async-comp-"
                                        (file-name-base source-file) "-")
                                nil ".el"))
-                   (expr-string (prin1-to-string expr))
+                   (expr-strings (mapcar #'prin1-to-string expr))
                    (_ (progn
                         (with-temp-file temp-file
-                          (insert expr-string))
+                          (mapc #'insert expr-strings))
                         (comp-log "\n")
-                        (comp-log expr-string)))
+                        (mapc #'comp-log expr-strings)))
                    (load1 load)
                    (process (make-process
                              :name (concat "Compiling: " source-file)

diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index cbd0e5747e8379b7a0985d93d5644e0effb0e27a..878db70609d5db2bbbdabfc3382e7fda0ee8258f 100644 (file)
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -501,6 +501,14 @@
               (format "%S"
                       (error-message-string err))))))
       (cl-return-from comp-test-46824-1-f))))
+
+(defun comp-test-47868-1-f ()
+  " ")
+
+(defun comp-test-47868-2-f ()
+  #(" " 0 1 (face font-lock-keyword-face)))
+
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index b618110bbe4f0adf4536b876229caec960644350..cb9032aa410b771f0ef162c439f5867aa98528a6 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -507,6 +507,10 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
   "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-02/msg01949.html>"
   (should (equal (comp-test-46824-1-f) nil)))
 
+(comp-deftest comp-test-47868-1 ()
+  (should-not (equal-including-properties (comp-test-47868-1-f)
+                                          (comp-test-47868-2-f))))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests. ;;