Browse Source

Fix for Mantis #21350

+ pgenutil.pas: 
    add a procedure which adds a type symbol to a non-Delphi-mode generic class or record which has the same name as the unit global dummy symbol for that generic. I don't know why I had that idea earlier as this will simplify some of the conditions in the parser again (I haven't changed these yet, but I hope to do that at least when I start working on generic functions).
* pgenutil.pas, generate_specialization:
    correctly handle "specialize TSomeGeneric<T>" as method parameter in a generic with the newly added rename symbol
* pdecobj.pas, object_dec & ptype.pas, record_dec: 
    call the procedure to add the rename symbol (the procedure checks whether the mode is correct)
* ppu.pas: 
    increase PPU version so that we don't use non-Delphi mode units with generics, but without the rename symbol
+ added tests:
    the one in webtbs are for classes/objects and those in test are for records

git-svn-id: trunk@21603 -
svenbarth 13 years ago
parent
commit
d2fabd2a22

+ 4 - 0
.gitattributes

@@ -10712,6 +10712,8 @@ tests/test/tgeneric72.pp svneol=native#text/pascal
 tests/test/tgeneric73.pp svneol=native#text/pascal
 tests/test/tgeneric74.pp svneol=native#text/pascal
 tests/test/tgeneric75.pp svneol=native#text/pascal
+tests/test/tgeneric76.pp svneol=native#text/pascal
+tests/test/tgeneric77.pp svneol=native#text/pascal
 tests/test/tgeneric8.pp svneol=native#text/plain
 tests/test/tgeneric9.pp svneol=native#text/plain
 tests/test/tgoto.pp svneol=native#text/plain
@@ -12599,6 +12601,8 @@ tests/webtbs/tw2128.pp svneol=native#text/plain
 tests/webtbs/tw2129.pp svneol=native#text/plain
 tests/webtbs/tw2129b.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
+tests/webtbs/tw21350a.pp svneol=native#text/pascal
+tests/webtbs/tw21350b.pp svneol=native#text/pascal
 tests/webtbs/tw21443.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
 tests/webtbs/tw21457.pp svneol=native#text/pascal

+ 4 - 0
compiler/pdecobj.pas

@@ -1409,6 +1409,10 @@ implementation
               include(current_structdef.defoptions, df_generic);
             parse_generic:=(df_generic in current_structdef.defoptions);
 
+            { in non-Delphi modes we need a strict private symbol without type
+              count and type parameters in the name to simply resolving }
+            maybe_insert_generic_rename_symbol(n,genericlist);
+
             { parse list of parent classes }
             { for record helpers in mode Delphi this is not allowed }
             if not (is_objectpascal_helper(current_objectdef) and

+ 49 - 2
compiler/pgenutil.pas

@@ -29,12 +29,15 @@ interface
 uses
   { common }
   cclasses,
+  { global }
+  globtype,
   { symtable }
   symtype,symdef,symbase;
 
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
     function parse_generic_parameters:TFPObjectList;
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
+    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
 
     type
       tspecializationstate = record
@@ -51,7 +54,7 @@ uses
   { common }
   cutils,fpccrc,
   { global }
-  globals,globtype,tokens,verbose,
+  globals,tokens,verbose,
   { symtable }
   symconst,symsym,symtable,
   { modules }
@@ -257,7 +260,8 @@ uses
           genname:=symname;
         { in case of non-Delphi mode the type name could already be a generic
           def (but maybe the wrong one) }
-        if assigned(genericdef) and (df_generic in genericdef.defoptions) then
+        if assigned(genericdef) and
+            ([df_generic,df_specialization]*genericdef.defoptions<>[]) then
           begin
             { remove the type count suffix from the generic's name }
             for i:=Length(genname) downto 1 do
@@ -266,6 +270,15 @@ uses
                   genname:=copy(genname,1,i-1);
                   break;
                 end;
+            { in case of a specialization we've only reached the specialization
+              checksum yet }
+            if df_specialization in genericdef.defoptions then
+              for i:=length(genname) downto 1 do
+                if genname[i]='$' then
+                  begin
+                    genname:=copy(genname,1,i-1);
+                    break;
+                  end;
           end;
         genname:=genname+'$'+countstr;
         ugenname:=upper(genname);
@@ -587,6 +600,40 @@ uses
           end;
        end;
 
+    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
+      var
+        gensym : ttypesym;
+      begin
+        { for generics in non-Delphi modes we insert a private type symbol
+          that has the same base name as the currently parsed generic and
+          that references this defs }
+        if not (m_delphi in current_settings.modeswitches) and
+            (
+              (
+                parse_generic and
+                assigned(genericlist) and
+                (genericlist.count>0)
+              ) or
+              (
+                assigned(current_specializedef) and
+                assigned(current_structdef.genericdef) and
+                (current_structdef.genericdef.typ in [objectdef,recorddef]) and
+                (pos('$',name)>0)
+              )
+            ) then
+          begin
+            { we need to pass nil as def here, because the constructor wants
+              to set the typesym of the def which is not what we want }
+            gensym:=ttypesym.create(copy(name,1,pos('$',name)-1),nil);
+            gensym.typedef:=current_structdef;
+            include(gensym.symoptions,sp_internal);
+            { the symbol should be only visible to the generic class
+              itself }
+            gensym.visibility:=vis_strictprivate;
+            symtablestack.top.insert(gensym);
+          end;
+      end;
+
     procedure specialization_init(genericdef:tdef;var state: tspecializationstate);
     var
       pu : tused_unit;

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 150;
+  CurrentPPUVersion = 151;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 4 - 0
compiler/ptype.pas

@@ -775,6 +775,10 @@ implementation
          if old_parse_generic then
            include(current_structdef.defoptions, df_generic);
          parse_generic:=(df_generic in current_structdef.defoptions);
+         { in non-Delphi modes we need a strict private symbol without type
+           count and type parameters in the name to simply resolving }
+         maybe_insert_generic_rename_symbol(n,genericlist);
+
          if m_advanced_records in current_settings.modeswitches then
            begin
              parse_record_members;

+ 45 - 0
tests/test/tgeneric76.pp

@@ -0,0 +1,45 @@
+{$mode delphi}
+
+unit tgeneric76;
+
+interface
+
+type
+
+  { TPointEx }
+
+  TPointEx<T> = record
+    X, Y: T;
+    function Create(const AX, AY: T): TPointEx<T>;
+    class procedure Swap(var A, B: TPointEx<T>); static;
+    class procedure OrderByY(var A, B: TPointEx<T>); static;
+  end;
+
+  TPoint = TPointEx<integer>;
+  TPointF = TPointEx<single>;
+
+implementation
+
+function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>;
+begin
+  result.X:=AX;
+  result.Y:=AY;
+end;
+
+class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>);
+var
+  tmp: TPointEx<T>;
+begin
+  tmp:=A;
+  A:=B;
+  B:=tmp;
+end;
+
+class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>);
+begin
+  if A.Y > B.Y then
+     TPointEx<T>.Swap(A,B);
+end;
+
+
+end.

+ 48 - 0
tests/test/tgeneric77.pp

@@ -0,0 +1,48 @@
+{$mode objfpc}{$h+}
+{$modeswitch advancedrecords}
+
+unit tgeneric77;
+
+interface
+
+type
+
+  { TPointEx }
+
+  generic TPointEx<T> = record
+    X, Y: T;
+    function Create(const AX, AY: T): TPointEx;
+    class procedure Swap(var A, B: TPointEx); static;
+    class procedure OrderByY(var A, B: TPointEx); static;
+  end;
+
+  //TPoint = specialize TPointEx<integer>;
+  TPointF = specialize TPointEx<single>;
+
+implementation
+
+{ TPoint<T> }
+
+function TPointEx.Create(const AX, AY: T): TPointEx;
+begin
+  result.X:=AX;
+  result.Y:=AY;
+end;
+
+class procedure TPointEx.Swap(var A, B: TPointEx);
+var
+  tmp: TPointEx;
+begin
+  tmp:=A;
+  A:=B;
+  B:=tmp;
+end;
+
+class procedure TPointEx.OrderByY(var A, B: TPointEx);
+begin
+  if A.Y > B.Y then
+     TPointEx.Swap(A,B);
+end;
+
+
+end.

+ 45 - 0
tests/webtbs/tw21350a.pp

@@ -0,0 +1,45 @@
+{$mode delphi}
+
+unit tw21350a;
+
+interface
+
+type
+
+  { TPointEx }
+
+  TPointEx<T> = object
+    X, Y: T;
+    function Create(const AX, AY: T): TPointEx<T>;
+    class procedure Swap(var A, B: TPointEx<T>); static;
+    class procedure OrderByY(var A, B: TPointEx<T>); static;
+  end;
+
+  TPoint = TPointEx<integer>;
+  TPointF = TPointEx<single>;
+
+implementation
+
+function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>;
+begin
+  result.X:=AX;
+  result.Y:=AY;
+end;
+
+class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>);
+var
+  tmp: TPointEx<T>;
+begin
+  tmp:=A;
+  A:=B;
+  B:=tmp;
+end;
+
+class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>);
+begin
+  if A.Y > B.Y then
+     TPointEx<T>.Swap(A,B);
+end;
+
+
+end.

+ 47 - 0
tests/webtbs/tw21350b.pp

@@ -0,0 +1,47 @@
+{$mode objfpc}{$h+}
+
+unit tw21350b;
+
+interface
+
+type
+
+  { TPointEx }
+
+  generic TPointEx<T> = object
+    X, Y: T;
+    function Create(const AX, AY: T): TPointEx;
+    class procedure Swap(var A, B: TPointEx); static;
+    class procedure OrderByY(var A, B: TPointEx); static;
+  end;
+
+  //TPoint = specialize TPointEx<integer>;
+  TPointF = specialize TPointEx<single>;
+
+implementation
+
+{ TPoint<T> }
+
+function TPointEx.Create(const AX, AY: T): TPointEx;
+begin
+  result.X:=AX;
+  result.Y:=AY;
+end;
+
+class procedure TPointEx.Swap(var A, B: TPointEx);
+var
+  tmp: TPointEx;
+begin
+  tmp:=A;
+  A:=B;
+  B:=tmp;
+end;
+
+class procedure TPointEx.OrderByY(var A, B: TPointEx);
+begin
+  if A.Y > B.Y then
+     TPointEx.Swap(A,B);
+end;
+
+
+end.