Browse Source

Fix for Mantis #25917. With this change the visibility of type parameters is changed from public to strict private as otherwise unexpected (and "unworkaroundable") errors might occur (like the one in the mentioned bug report).

pgenutil.pas:
  * parse_generic_parameters & insert_generic_parameter_types: create the type parameter symbols as strict private instead of public (which is the default visiblity)

* adjusted two tests which relied on this behavior (that's why I fixed the type aliases previously)
+ added test

git-svn-id: trunk@29486 -
svenbarth 10 years ago
parent
commit
0d1d3d8e72
5 changed files with 44 additions and 3 deletions
  1. 1 0
      .gitattributes
  2. 4 0
      compiler/pgenutil.pas
  3. 3 2
      tests/webtbs/tw10247.pp
  4. 2 1
      tests/webtbs/tw10247b.pp
  5. 34 0
      tests/webtbs/tw25917.pp

+ 1 - 0
.gitattributes

@@ -14119,6 +14119,7 @@ tests/webtbs/tw2589.pp svneol=native#text/plain
 tests/webtbs/tw25895.pp svneol=native#text/pascal
 tests/webtbs/tw25895.pp svneol=native#text/pascal
 tests/webtbs/tw25916a.pp svneol=native#text/pascal
 tests/webtbs/tw25916a.pp svneol=native#text/pascal
 tests/webtbs/tw25916b.pp svneol=native#text/pascal
 tests/webtbs/tw25916b.pp svneol=native#text/pascal
+tests/webtbs/tw25917.pp svneol=native#text/pascal
 tests/webtbs/tw25929.pp svneol=native#text/pascal
 tests/webtbs/tw25929.pp svneol=native#text/pascal
 tests/webtbs/tw25930.pp svneol=native#text/plain
 tests/webtbs/tw25930.pp svneol=native#text/plain
 tests/webtbs/tw25931.pp -text svneol=native#text/plain
 tests/webtbs/tw25931.pp -text svneol=native#text/plain

+ 4 - 0
compiler/pgenutil.pas

@@ -991,6 +991,8 @@ uses
           if token=_ID then
           if token=_ID then
             begin
             begin
               generictype:=ctypesym.create(orgpattern,cundefinedtype);
               generictype:=ctypesym.create(orgpattern,cundefinedtype);
+              { type parameters need to be added as strict private }
+              generictype.visibility:=vis_strictprivate;
               include(generictype.symoptions,sp_generic_para);
               include(generictype.symoptions,sp_generic_para);
               result.add(orgpattern,generictype);
               result.add(orgpattern,generictype);
             end;
             end;
@@ -1166,6 +1168,8 @@ uses
             if assigned(generictype.owner) then
             if assigned(generictype.owner) then
               begin
               begin
                 sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
                 sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
+                { type parameters need to be added as strict private }
+                sym.visibility:=vis_strictprivate;
                 st.insert(sym);
                 st.insert(sym);
                 include(sym.symoptions,sp_generic_para);
                 include(sym.symoptions,sp_generic_para);
               end
               end

+ 3 - 2
tests/webtbs/tw10247.pp

@@ -4,6 +4,7 @@ type
   generic TNode<T> = class
   generic TNode<T> = class
   public
   public
     type
     type
+      TAlias = T;
       PT = ^T;
       PT = ^T;
   private
   private
     var
     var
@@ -25,7 +26,7 @@ type
     destructor Destroy; override;
     destructor Destroy; override;
 
 
     function GetAddr: TTNode.PT;
     function GetAddr: TTNode.PT;
-    procedure SetV(v: TTNode.T);
+    procedure SetV(v: TTNode.TAlias);
   end;
   end;
 
 
 constructor TNode.Create;
 constructor TNode.Create;
@@ -54,7 +55,7 @@ begin
 end;
 end;
 
 
 
 
-procedure TContainer.SetV(v: TTNode.T);
+procedure TContainer.SetV(v: TTNode.TAlias);
 begin
 begin
   Data.Data:=v;
   Data.Data:=v;
 end;
 end;

+ 2 - 1
tests/webtbs/tw10247b.pp

@@ -3,6 +3,7 @@ type
   generic TNode<T> = class
   generic TNode<T> = class
   public
   public
     type
     type
+      TAlias = T;
       PT = T;
       PT = T;
   private
   private
     var
     var
@@ -26,7 +27,7 @@ begin
 end;
 end;
 
 
 
 
-function GetIntNode: TTNodeLongint.T;
+function GetIntNode: TTNodeLongint.TAlias;
 begin
 begin
   result := 10;
   result := 10;
 end;
 end;

+ 34 - 0
tests/webtbs/tw25917.pp

@@ -0,0 +1,34 @@
+{ %NORUN }
+
+program tw25917;
+
+{$APPTYPE CONSOLE}
+{$MODE DELPHI}
+
+type
+  TA<T1, T2> = class
+  end;
+
+  TB<T1, T2> = class
+  private
+    type
+      T3 = record end;
+
+      TC = class(TA<T1, T3>)
+      public
+        procedure Foo;
+      end;
+  end;
+
+procedure TB<T1, T2>.TC.Foo;
+var
+  L: TB<T1, T2>.T3;
+begin
+end;
+
+var
+  x: TB<Pointer, Pointer>;
+
+begin
+end.
+