mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 04:48:07 +02:00
* 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:
parent
8b293f106b
commit
f936a48afa
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -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
|
||||
|
@ -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
25
tests/webtbs/tw25610.pp
Normal 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
17
tests/webtbs/uw25610a.pp
Normal 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
17
tests/webtbs/uw25610b.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user