From f936a48afa1789db02daac01b2004941f2fa002e Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 20 Mar 2014 21:03:07 +0000 Subject: [PATCH] * don't change the forward/interface definition of regular forward/interface functions whose implementation is declared "external". This results in less efficient code (all calls will go through a stub), but it prevents interface crc changes (-> no recompilations in case of circular dependencies) and it also keeps the interface stable (if the external implementation is changed afterwards to another external routine or to a local implementation, the mangled name of the routine does not change) (mantis #24121) git-svn-id: trunk@27213 - --- .gitattributes | 3 +++ compiler/psub.pas | 47 ++++++++++++++++++++++++---------------- tests/webtbs/tw25610.pp | 25 +++++++++++++++++++++ tests/webtbs/uw25610a.pp | 17 +++++++++++++++ tests/webtbs/uw25610b.pp | 17 +++++++++++++++ 5 files changed, 90 insertions(+), 19 deletions(-) create mode 100644 tests/webtbs/tw25610.pp create mode 100644 tests/webtbs/uw25610a.pp create mode 100644 tests/webtbs/uw25610b.pp diff --git a/.gitattributes b/.gitattributes index 31d0ecee05..1b51d4e495 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13841,6 +13841,7 @@ tests/webtbs/tw25551.pp svneol=native#text/plain tests/webtbs/tw25598.pp svneol=native#text/plain tests/webtbs/tw25603.pp svneol=native#text/pascal tests/webtbs/tw2561.pp svneol=native#text/plain +tests/webtbs/tw25610.pp -text svneol=native#text/plain tests/webtbs/tw25685.pp svneol=native#text/pascal tests/webtbs/tw25814.pp svneol=native#text/plain tests/webtbs/tw25869.pp svneol=native#text/plain @@ -14620,6 +14621,8 @@ tests/webtbs/uw25059.test.pp svneol=native#text/pascal tests/webtbs/uw25059.withdot.pp svneol=native#text/pascal tests/webtbs/uw25132.pp svneol=native#text/pascal tests/webtbs/uw25598.pp svneol=native#text/plain +tests/webtbs/uw25610a.pp -text svneol=native#text/plain +tests/webtbs/uw25610b.pp -text svneol=native#text/plain tests/webtbs/uw25814.pp svneol=native#text/plain tests/webtbs/uw2706a.pp svneol=native#text/plain tests/webtbs/uw2706b.pp svneol=native#text/plain diff --git a/compiler/psub.pas b/compiler/psub.pas index eed8e969ff..b5b1c43b23 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -2059,25 +2059,6 @@ implementation { Handle imports } if (po_external in pd.procoptions) then begin - { External declared in implementation, and there was already a - forward (or interface) declaration then we need to generate - a stub that calls the external routine } - if (not pd.forwarddef) and - (pd.hasforward) - { it is unclear to me what's the use of the following condition, - so commented out, see also issue #18371 (FK) - and - not( - assigned(pd.import_dll) and - (target_info.system in [system_i386_wdosx, - system_arm_wince,system_i386_wince]) - ) } then - begin - s:=proc_get_importname(pd); - if s<>'' then - gen_external_stub(current_asmdata.asmlists[al_procedures],pd,s); - end; - { Import DLL specified? } if assigned(pd.import_dll) then begin @@ -2096,6 +2077,34 @@ implementation if tf_has_dllscanner in target_info.flags then current_module.dllscannerinputlist.Add(proc_get_importname(pd),pd); end; + + { External declared in implementation, and there was already a + forward (or interface) declaration then we need to generate + a stub that calls the external routine } + if (not pd.forwarddef) and + (pd.hasforward) + { it is unclear to me what's the use of the following condition, + so commented out, see also issue #18371 (FK) + and + not( + assigned(pd.import_dll) and + (target_info.system in [system_i386_wdosx, + system_arm_wince,system_i386_wince]) + ) } then + begin + s:=proc_get_importname(pd); + if s<>'' then + gen_external_stub(current_asmdata.asmlists[al_procedures],pd,s); + { remove the external stuff, so that the interface crc + doesn't change. This makes the function calls less + efficient, but it means that the interface doesn't + change if the function is ever redirected to another + function or implemented in the unit. } + pd.procoptions:=pd.procoptions-[po_external,po_has_importname,po_has_importdll]; + stringdispose(pd.import_name); + stringdispose(pd.import_dll); + pd.import_nr:=0; + end; end; end; diff --git a/tests/webtbs/tw25610.pp b/tests/webtbs/tw25610.pp new file mode 100644 index 0000000000..86bab00198 --- /dev/null +++ b/tests/webtbs/tw25610.pp @@ -0,0 +1,25 @@ +{ %recompile=-drecompile} +{ %norun } + +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit tw25610; + +interface + +uses + uw25610a, uw25610b; + +implementation + +procedure Register; +var + arr: array of byte; +begin + setlength(arr,1); + DynArraySize(pointer(arr)); +end; + +end. diff --git a/tests/webtbs/uw25610a.pp b/tests/webtbs/uw25610a.pp new file mode 100644 index 0000000000..442091de86 --- /dev/null +++ b/tests/webtbs/uw25610a.pp @@ -0,0 +1,17 @@ +unit uw25610a; + +interface + +uses + uw25610b; + +{$ifdef recompile} +{$error this unit should not be recompiled} +{$endif} + +resourcestring + Foo = 'Foo'; + +implementation + +end. diff --git a/tests/webtbs/uw25610b.pp b/tests/webtbs/uw25610b.pp new file mode 100644 index 0000000000..04357b2e14 --- /dev/null +++ b/tests/webtbs/uw25610b.pp @@ -0,0 +1,17 @@ +unit uw25610b; + +interface + +function DynArraySize(p : pointer): tdynarrayindex; + +implementation + +uses + uw25610a; + +function DynArraySize(p : pointer): tdynarrayindex; external name 'FPC_DYNARRAY_LENGTH'; + +begin + upcase(Foo); +end. +