~ 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