2
0
Эх сурвалжийг харах

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

Jonas Maebe 11 жил өмнө
parent
commit
f936a48afa

+ 3 - 0
.gitattributes

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

+ 28 - 19
compiler/psub.pas

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

+ 17 - 0
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.

+ 17 - 0
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.
+