master f9f9c95ab57: Fix native compilation in dynamically bound files.

[Alan Mackenzie]

branch: master
commit f9f9c95ab578dee680093cf3f1e618c770fc22c3
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>

    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
    #
---
 lisp/emacs-lisp/comp.el                         | 48 +++++++++++++++----------
 test/src/comp-resources/comp-test-funcs-dyn2.el | 31 ++++++++++++++++
 test/src/comp-tests.el                          |  7 +++-
 3 files changed, 67 insertions(+), 19 deletions(-)

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4892733d456..b35e1b97e9d 100644
--- 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
index 00000000000..3d70489d1ca
--- /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 ce7899d9d4c..30dfd669ded 100644
--- 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