Parcourir la source

compiler: add owner hierarchy prefix for mangled name of parameter def to prevent asm symbols collision (issue #0020940)

git-svn-id: trunk@20163 -
paul il y a 13 ans
Parent
commit
310c396cfc
4 fichiers modifiés avec 110 ajouts et 2 suppressions
  1. 2 0
      .gitattributes
  2. 3 2
      compiler/symtype.pas
  3. 51 0
      tests/webtbs/tw20940.pp
  4. 54 0
      tests/webtbs/uw20940.pp

+ 2 - 0
.gitattributes

@@ -12164,6 +12164,7 @@ tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
 tests/webtbs/tw20889.pp svneol=native#text/pascal
 tests/webtbs/tw20909.pp svneol=native#text/pascal
+tests/webtbs/tw20940.pp svneol=native#text/pascal
 tests/webtbs/tw20962.pp svneol=native#text/plain
 tests/webtbs/tw20995a.pp svneol=native#text/pascal
 tests/webtbs/tw20995b.pp svneol=native#text/pascal
@@ -12989,6 +12990,7 @@ tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw20909a.pas svneol=native#text/pascal
 tests/webtbs/uw20909b.pas svneol=native#text/pascal
+tests/webtbs/uw20940.pp svneol=native#text/pascal
 tests/webtbs/uw2266a.inc svneol=native#text/plain
 tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain

+ 3 - 2
compiler/symtype.pas

@@ -289,10 +289,11 @@ implementation
 
     function tdef.mangledparaname:string;
       begin
+        result:=OwnerHierarchyName;
         if assigned(typesym) then
-         mangledparaname:=typesym.name
+          mangledparaname:=result+typesym.name
         else
-         mangledparaname:=getmangledparaname;
+          mangledparaname:=result+getmangledparaname;
       end;
 
 

+ 51 - 0
tests/webtbs/tw20940.pp

@@ -0,0 +1,51 @@
+program tw20940;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, uw20940;
+
+Type
+  TMyEvent=procedure(var Items:Storage.Folders.TItem) of Object;
+  TMyClass=class
+  private
+    FFolders : uw20940.Storage.Folders.TItems;
+    FOnChange : uw20940.Storage.Folders.TItemsEvent;
+    FMyEvent : TMyEvent;
+  public
+    property OnChange:Storage.Folders.TItemsEvent read FOnChange write FOnChange;
+    //property MyEvent:TMyEvent read FOnMyEvent write FOnMyEvent;
+  end;
+
+  TOtherClass=class
+    function  SomeMethod(Var ItemP:uw20940.Storage.Folders.PItem):uw20940.Storage.Folders.PItem;
+    procedure MyEvent(var Item:uw20940.Storage.Resources.TItem); overload;
+    {remove comment} procedure MyEvent(var Item:uw20940.Storage.Folders.TItem); overload;
+    {remove comment} procedure MyEvent(var Item:uw20940.Storage.Files.TItem); overload;
+  end;
+
+  function TOtherClass.SomeMethod(Var ItemP:uw20940.Storage.Folders.PItem):uw20940.Storage.Folders.PItem;
+  begin
+
+  end;
+
+  procedure TOtherClass.MyEvent(var Item:uw20940.Storage.Resources.TItem);
+  begin
+
+  end;
+  procedure TOtherClass.MyEvent(var Item:uw20940.Storage.Folders.TItem);
+  begin
+
+  end;
+
+
+  procedure TOtherClass.MyEvent(var Item:uw20940.Storage.Files.TItem);
+  begin
+
+  end;
+
+begin
+
+
+end.
+

+ 54 - 0
tests/webtbs/uw20940.pp

@@ -0,0 +1,54 @@
+unit uw20940; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+Type
+  Storage=class
+  type
+    Folders=class
+    Const
+      FLAG_REFRESH = 1;
+      FLAG_DELETE  = 2;
+    Type
+      TItem=record
+        ID:Int64;
+        Path:string;
+      end;
+      PItem=^TItem;
+      TItems=array of PItem;
+      PItems=^TItems;
+
+      TItemsEvent=procedure(Var Items:TItems) of Object;
+    end;
+    Files=class
+    Type
+      PItem=^TItem;
+      TItem=record
+        Name :string;
+        Created:TDateTime;
+      end;
+      TItems=Array of PItem;
+      TItemsEvent=procedure(Var Items:TItems) of Object;
+    end;
+    Resources=class
+    Type
+      PItem=^TItem;
+      TItem=record
+        Name :string;
+        Description:string;
+        Manifest:string;
+      end;
+      TItems=Array of PItem;
+      TItemsEvent=procedure(Var Items:TItems) of Object;
+    end;
+  end;
+
+implementation
+
+end.
+