Fix native compilation in dynamically bound files.

This fixes bug#64642.

* lisp/emacs-lisp/comp.el (comp-spill-lap-function/symbol): Add
code for dynamically bound functions.

* test/src/comp-tests.el (comp-tests-result-lambda): New test.

* test/src/comp-resources/comp-test-funcs-dyn2.el: New test
file.

# Please enter the commit message for your changes. Lines starting
# with '#' will be ignored, and an empty message aborts the commit.
#
# On branch master
# Your branch is up to date with 'origin/master'.
#
# Changes to be committed:
#	modified:   lisp/emacs-lisp/comp.el
#	new file:   test/src/comp-resources/comp-test-funcs-dyn2.el
#	modified:   test/src/comp-tests.el
#
# Changes not staged for commit:
#	modified:   .gitignore
#
# Untracked files:
#	.gitignore.acm
#	.gitignore.backup
#	.timestamps.txt
#	2021-01-03.err
#	2021-01-06.err
#	2021-12-16.make
#	2021-12-30.err
#	2021-12-31.err
#	2022-01-01.err
#	2022-01-02.check.err
#	2022-01-02.err
#	2022-01-04.err
#	2022-01-05.err
#	2022-01-06.err
#	2022-01-07.err
#	2022-01-07.outerr
#	2022-01-08.err
#	2022-01-09.err
#	2022-01-09b.err
#	2022-01-10.err
#	2022-01-11
#	2022-01-11.err
#	2022-02-22.err
#	2022-02-22.outerr
#	checkout.20220228.out
#	checkout.20220301.out
#	checkout.20220302.out
#	doc/lispref/syntax.20160318.techsi
#	doc/lispref/syntax.20160318b.techsi
#	lib/.deps/
#	lisp/2022-01-09.err
#	lisp/emacs-lisp/comp.el.rej
#	src/2021-12-20.err
#	src/globals.20211124.aitch
#	src/lisp.20211127.aitch
#	test/lisp/calendar/icalendar-tests.elcr5m9Wq
#

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4892733d4565e7181a01fdd0d2933ad1c413c090..b35e1b97e9dab5298ac628e5dbc3ab52841be808 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1301,33 +1301,45 @@ clashes."
           (make-temp-file (comp-c-func-name function-name "freefn-")
                           nil ".eln")))
   (let* ((f (symbol-function function-name))
+         (byte-code (byte-compile function-name))
          (c-name (comp-c-func-name function-name "F"))
-         (func (make-comp-func-l :name function-name
-                                 :c-name c-name
-                                 :doc (documentation f t)
-                                 :int-spec (interactive-form f)
-                                 :command-modes (command-modes f)
-                                 :speed (comp-spill-speed function-name)
-                                 :pure (comp-spill-decl-spec function-name
-                                                             'pure))))
+         (func
+          (if (comp-lex-byte-func-p byte-code)
+              (make-comp-func-l :name function-name
+                                :c-name c-name
+                                :doc (documentation f t)
+                                :int-spec (interactive-form f)
+                                :command-modes (command-modes f)
+                                :speed (comp-spill-speed function-name)
+                                :pure (comp-spill-decl-spec function-name
+                                                            'pure))
+            (make-comp-func-d :name function-name
+                              :c-name c-name
+                              :doc (documentation f t)
+                              :int-spec (interactive-form f)
+                              :command-modes (command-modes f)
+                              :speed (comp-spill-speed function-name)
+                              :pure (comp-spill-decl-spec function-name
+                                                          'pure)))))
       (when (byte-code-function-p f)
         (signal 'native-compiler-error
                 '("can't native compile an already byte-compiled function")))
-      (setf (comp-func-byte-func func)
-            (byte-compile (comp-func-name func)))
+      (setf (comp-func-byte-func func) byte-code)
       (let ((lap (byte-to-native-lambda-lap
                   (gethash (aref (comp-func-byte-func func) 1)
                            byte-to-native-lambdas-h))))
         (cl-assert lap)
         (comp-log lap 2 t)
-        (let ((arg-list (aref (comp-func-byte-func func) 0)))
-          (setf (comp-func-l-args func)
-                (comp-decrypt-arg-list arg-list function-name)
-                (comp-func-lap func)
-                lap
-                (comp-func-frame-size func)
-                (comp-byte-frame-size (comp-func-byte-func func))))
-        (setf (comp-ctxt-top-level-forms comp-ctxt)
+        (if (comp-func-l-p func)
+            (let ((arg-list (aref (comp-func-byte-func func) 0)))
+              (setf (comp-func-l-args func)
+                    (comp-decrypt-arg-list arg-list function-name)))
+          (setf (comp-func-d-lambda-list func) (cadr f)))
+        (setf (comp-func-lap func)
+              lap
+              (comp-func-frame-size func)
+              (comp-byte-frame-size (comp-func-byte-func func))
+              (comp-ctxt-top-level-forms comp-ctxt)
               (list (make-byte-to-native-func-def :name function-name
                                                   :c-name c-name)))
         (comp-add-func-to-ctxt func))))

diff --git a/test/src/comp-resources/comp-test-funcs-dyn2.el b/test/src/comp-resources/comp-test-funcs-dyn2.el
new file mode 100644 (file)
index 0000000..3d70489
--- /dev/null
+++ b/test/src/comp-resources/comp-test-funcs-dyn2.el
@@ -0,0 +1,31 @@
+;;; comp-test-funcs-dyn2.el -*- lexical-binding: nil; no-byte-compile: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Alan Mackenzie <acm@muc.de>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Test the compilation of a function under dynamic binding.
+
+;;; Code:
+
+(defun comp-tests-result-lambda ()
+  (lambda (bar) (car bar)))
+
+(provide 'comp-test-funcs-dyn2)
+;;; comp-test-funcs-dyn2.el ends here.

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index ce7899d9d4cf9dfa42ba79b24dba5796456172fb..30dfd669ded7096fb8bfe60603f2a35a337edeb5 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -33,7 +33,8 @@
 
 (eval-and-compile
   (defconst comp-test-src (ert-resource-file "comp-test-funcs.el"))
-  (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")))
+  (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el"))
+  (defconst comp-test-dyn-src2 (ert-resource-file "comp-test-funcs-dyn2.el")))
 
 (when (native-comp-available-p)
   (message "Compiling tests...")
@@ -44,6 +45,7 @@
 ;; names used in this file.
 (require 'comp-test-funcs comp-test-src)
 (require 'comp-test-dyn-funcs comp-test-dyn-src) ;Non-standard feature name!
+(require 'comp-test-funcs-dyn2 comp-test-dyn-src2)
 
 (defmacro comp-deftest (name args &rest docstring-and-body)
   "Define a test for the native compiler tagging it as :nativecomp."
@@ -1528,4 +1530,7 @@ folded."
           (equal (comp-mvar-typeset mvar)
                  comp-tests-cond-rw-expected-type))))))))
 
+(ert-deftest comp-tests-result-lambda ()
+  (native-compile 'comp-tests-result-lambda)
+  (should (eq (funcall (comp-tests-result-lambda) '(a . b)) 'a)))
 ;;; comp-tests.el ends here