mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-10 21:19:32 +01: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/tw25598.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw25603.pp svneol=native#text/pascal
|
tests/webtbs/tw25603.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2561.pp svneol=native#text/plain
|
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/tw25685.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw25814.pp svneol=native#text/plain
|
tests/webtbs/tw25814.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw25869.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/uw25059.withdot.pp svneol=native#text/pascal
|
||||||
tests/webtbs/uw25132.pp svneol=native#text/pascal
|
tests/webtbs/uw25132.pp svneol=native#text/pascal
|
||||||
tests/webtbs/uw25598.pp svneol=native#text/plain
|
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/uw25814.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw2706a.pp svneol=native#text/plain
|
tests/webtbs/uw2706a.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw2706b.pp svneol=native#text/plain
|
tests/webtbs/uw2706b.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -2059,25 +2059,6 @@ implementation
|
|||||||
{ Handle imports }
|
{ Handle imports }
|
||||||
if (po_external in pd.procoptions) then
|
if (po_external in pd.procoptions) then
|
||||||
begin
|
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? }
|
{ Import DLL specified? }
|
||||||
if assigned(pd.import_dll) then
|
if assigned(pd.import_dll) then
|
||||||
begin
|
begin
|
||||||
@ -2096,6 +2077,34 @@ implementation
|
|||||||
if tf_has_dllscanner in target_info.flags then
|
if tf_has_dllscanner in target_info.flags then
|
||||||
current_module.dllscannerinputlist.Add(proc_get_importname(pd),pd);
|
current_module.dllscannerinputlist.Add(proc_get_importname(pd),pd);
|
||||||
end;
|
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;
|
||||||
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