~ chicken-core (chicken-5) e28243f97cbfef618e3a5624f19c0af9dd98d6d6


commit e28243f97cbfef618e3a5624f19c0af9dd98d6d6
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Mon Feb 10 15:54:26 2020 +0100
Commit:     megane <meganeka@gmail.com>
CommitDate: Wed Feb 12 17:20:50 2020 +0200

    Don't directly call external inlineable procedures (fixes #1665)
    
    When a procedure is external, its fid refers to a static function in
    another compilation unit, so we can't create a direct call to that
    function, even though the procedure itself is inlineable.  Therefore,
    avoid creating direct calls.
    
    Signed-off-by: megane <meganeka@gmail.com>

diff --git a/core.scm b/core.scm
index 62b3fa67..a490915a 100644
--- a/core.scm
+++ b/core.scm
@@ -2588,6 +2588,8 @@
 							 'no
 							 (variable-mark
 							  varname '##compiler#inline)))
+						   ;; May not be external, see #1665
+						   (not (node? (variable-mark varname '##compiler#inline-global)))
 						   (or (test varname 'value)
 						       (test varname 'local-value)))] )
 				    (if (and val (eq? '##core#lambda (node-class val)))
diff --git a/tests/inline-me.scm b/tests/inline-me.scm
index f66ce670..d8859555 100644
--- a/tests/inline-me.scm
+++ b/tests/inline-me.scm
@@ -1,9 +1,11 @@
 (module
  inline-me
- (foreign-foo)
+ (foreign-foo external-foo)
  (import scheme (chicken base))
  (import (only (chicken foreign) foreign-lambda*))
 
  (define foreign-foo (foreign-lambda* int ((int x)) "C_return ( x + 1 );"))
 
+ (define (external-foo x y) (display x y))
+
 )
diff --git a/tests/inlining-tests.scm b/tests/inlining-tests.scm
index 9adc0f64..54636b31 100644
--- a/tests/inlining-tests.scm
+++ b/tests/inlining-tests.scm
@@ -28,3 +28,23 @@
 
 (import inline-me)
 (assert (= 42 (foreign-foo 41)))
+
+;; #1665, don't replace calls to inlinable procedures with direct
+;; calls when those procedures are external (via an inline file).
+(module test-1665
+    ()
+
+  (import scheme inline-me)
+
+  (define (inline-external-with-unroll-limit-test x)
+    (lambda (x)
+      (lambda (a)
+	(if a
+            (external-foo x 'xxx)
+            (if x
+		(external-foo x 'yyy)
+		(external-foo x 'zzz)))
+	1)))
+
+  (inline-external-with-unroll-limit-test 'yo)
+  (inline-external-with-unroll-limit-test 'yo2))
Trap