* 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 -
This commit is contained in:
Jonas Maebe 2014-03-20 21:03:07 +00:00
parent 8b293f106b
commit f936a48afa
5 changed files with 90 additions and 19 deletions

3
.gitattributes vendored
View File

@ -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

View File

@ -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;

25
tests/webtbs/tw25610.pp Normal file
View File

@ -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.

17
tests/webtbs/uw25610a.pp Normal file
View File

@ -0,0 +1,17 @@
unit uw25610a;
interface
uses
uw25610b;
{$ifdef recompile}
{$error this unit should not be recompiled}
{$endif}
resourcestring
Foo = 'Foo';
implementation
end.

17
tests/webtbs/uw25610b.pp Normal file
View File

@ -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.