From a9065d1d8e3415fb92ef3b562545e2f6f8ccff08 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Wed, 18 Mar 2020 22:00:57 +0100
Subject: [PATCH] cmp: fix closure type for local functions calling closures

When a local function calls a closure it has to be a closure too. Thus
when updating the closure type for a function f, we have to possibly
update also all functions referencing f.

Fixes #545.
---
 src/cmp/cmpflet.lsp                 |  3 ++-
 src/tests/normal-tests/compiler.lsp | 23 +++++++++++++++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp
index 6d50babce..116505035 100644
--- a/src/cmp/cmpflet.lsp
+++ b/src/cmp/cmpflet.lsp
@@ -151,13 +151,14 @@
     ;; This recursive algorithm is guaranteed to stop when functions
     ;; do not change.
     (let ((new-type (compute-closure-type fun))
-          (to-be-updated (fun-child-funs fun)))
+          to-be-updated)
       ;; Same type
       (when (eq new-type old-type)
         (return-from update-fun-closure-type nil))
       (when (fun-global fun)
         (cmpnote "Function ~A is global but is closed over some variables.~%~{~A ~}"
                  (fun-name fun) (mapcar #'var-name (fun-referenced-vars fun))))
+      (setf to-be-updated (append (fun-child-funs fun) (fun-referencing-funs fun)))
       (setf (fun-closure fun) new-type)
       ;; All external, non-global variables become of type closure
       (when (eq new-type 'CLOSURE)
diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp
index ee960b529..1dfd6d0ae 100644
--- a/src/tests/normal-tests/compiler.lsp
+++ b/src/tests/normal-tests/compiler.lsp
@@ -1606,3 +1606,26 @@
         (check-fn (make-fn (1+ si::c-arguments-limit)))
         (check-fn (make-fn (1- si::c-arguments-limit)))
         (check-fn (make-fn si::c-arguments-limit))))
+
+;;; Date 2020-03-18
+;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/issues/545
+;;; Description
+;;;
+;;; The closure type for local functions calling global closures was
+;;; not determined correctly to also be a global closure.
+(test cmp.0075.local-fun.closure-type
+  (ext:with-clean-symbols (*function*)
+    (defvar *function*)
+    (let ((result
+           (funcall
+            (compile nil
+                     (lambda (b)
+                       (flet ((%f10 () b))
+                         (flet ((%f4 () (%f10)))
+                           (incf b)
+                           (setf *function* #'%f10) ; makes a global
+                                                    ; closure out of %f10
+                           (%f4)))))
+            3)))
+    (is (eq result 4))
+    (is (eq (funcall *function*) 4)))))