fcl-passrc: resolver: objfpc: canonical alias to spec record type

git-svn-id: trunk@43220 -

packages/fcl-passrc/src/pasresolver.pp

@@ -17944,7 +17944,7 @@ end;
 procedure TPasResolver.SpecializeRecordType(GenEl, SpecEl: TPasRecordType;
   SpecializedItem: TPRSpecializedTypeItem);
 var
-  GenScope: TPasGenericScope;
+  SpecScope: TPasGenericScope;
 begin
   SpecEl.PackMode:=GenEl.PackMode;
   if SpecializedItem<>nil then
@@ -17952,18 +17952,23 @@ begin
     // specialized generic record
     if SpecEl.CustomData<>nil then
       RaiseNotYetImplemented(20190921204740,SpecEl);
-    GenScope:=TPasGenericScope(PushScope(SpecEl,TPasRecordScope));
-    GenScope.VisibilityContext:=SpecEl;
-    GenScope.SpecializedFromItem:=SpecializedItem;
+    SpecScope:=TPasGenericScope(PushScope(SpecEl,TPasRecordScope));
+    SpecScope.VisibilityContext:=SpecEl;
+    SpecScope.SpecializedFromItem:=SpecializedItem;
     AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
-                                      SpecializedItem,GenScope,true);
+                                      SpecializedItem,SpecScope,true);
+    if not (msDelphi in CurrentParser.CurrentModeswitches) then
+      begin
+      // ObjFPC: add canonical type alias
+      SpecScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
+      end;
     end
   else if GenEl.GenericTemplateTypes.Count>0 then
     begin
     // generic recordtype inside a generic type
     if SpecEl.CustomData=nil then
       RaiseNotYetImplemented(20190815201634,SpecEl);
-    GenScope:=TPasGenericScope(SpecEl.CustomData);
+    SpecScope:=TPasGenericScope(SpecEl.CustomData);
     RaiseNotYetImplemented(20190815194327,GenEl);
     end;
   // specialize sub elements

packages/pastojs/tests/tcgenerics.pas

@@ -16,6 +16,9 @@ type
   Published
     // generic record
     Procedure TestGen_RecordEmpty;
+    Procedure TestGen_Record_ClassProc_ObjFPC;
+    //Procedure TestGen_Record_ClassProc_Delphi;
+    //Procedure TestGen_Record_ReferGenClass_DelphiFail;
 
     // generic class
     Procedure TestGen_ClassEmpty;
@@ -87,6 +90,48 @@ begin
     ]));
 end;
 
+procedure TTestGenerics.TestGen_Record_ClassProc_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  generic TPoint<T> = record',
+  '    class var x: T;',
+  '    class procedure Fly; static;',
+  '  end;',
+  'class procedure Tpoint.Fly;',
+  'begin',
+  //'  x:=x+3;',
+  '  tpoint.x:=tpoint.x+4;',
+  //'  Fly;',
+  '  tpoint.Fly;',
+  'end;',
+  'var p: specialize TPoint<word>;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Record_ClassProc',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TPoint$G1", function () {',
+    '  this.x = 0;',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  this.Fly = function () {',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 4;',
+    '    $mod.TPoint$G1.Fly();',
+    '  };',
+    '}, true);',
+    'this.p = $mod.TPoint$G1.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ClassEmpty;
 begin
   StartProgram(false);