From: Andrea Corallo Date: Wed, 21 Apr 2021 13:23:23 +0000 (+0200) Subject: Fix native compiler string hash consing strategy (bug#47868) X-Git-Tag: emacs-28.0.90~2727^2~5 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f842816125c54a46eb786ff15622d88792e7677a;p=emacs.git 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 0122008fc9e..394b8cb73c0 100644 --- 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 cbd0e5747e8..878db70609d 100644 --- 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))) + + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index b618110bbe4..cb9032aa410 100644 --- 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." "" (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)))) + ;;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests. ;;