From aa3447ac747611ca6b381f398e65c051fd79f761 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Mon, 10 Feb 2020 15:54:26 +0100
Subject: [PATCH] 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.
---
 core.scm                 |  2 ++
 tests/inline-me.scm      |  4 +++-
 tests/inlining-tests.scm | 20 ++++++++++++++++++++
 3 files changed, 25 insertions(+), 1 deletion(-)

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))
-- 
2.20.1