Browse Source

pastojs: filer: generic array

git-svn-id: trunk@47240 -
Mattias Gaertner 4 years ago
parent
commit
57cdc30a62
2 changed files with 62 additions and 2 deletions
  1. 28 2
      packages/pastojs/src/pas2jsfiler.pp
  2. 34 0
      packages/pastojs/tests/tcfiler.pas

+ 28 - 2
packages/pastojs/src/pas2jsfiler.pp

@@ -841,6 +841,7 @@ type
     procedure WriteSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUWriterContext); virtual;
     procedure WriteSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUWriterContext); virtual;
     procedure WriteInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext); virtual;
     procedure WriteInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext); virtual;
     procedure WriteRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUWriterContext); virtual;
     procedure WriteRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUWriterContext); virtual;
+    procedure WriteArrayTypeScope(Obj: TJSONObject; Scope: TPas2JSArrayScope; aContext: TPCUWriterContext); virtual;
     procedure WriteArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUWriterContext); virtual;
     procedure WriteArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUWriterContext); virtual;
     procedure WriteFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUWriterContext); virtual;
     procedure WriteFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUWriterContext); virtual;
     procedure WriteEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUWriterContext); virtual;
     procedure WriteEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUWriterContext); virtual;
@@ -1147,6 +1148,7 @@ type
     procedure ReadSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUReaderContext); virtual;
     procedure ReadSpecializeType(Obj: TJSONObject; El: TPasSpecializeType; aContext: TPCUReaderContext); virtual;
     procedure ReadInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext); virtual;
     procedure ReadInlineSpecializeExpr(Obj: TJSONObject; Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext); virtual;
     procedure ReadRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUReaderContext); virtual;
     procedure ReadRangeType(Obj: TJSONObject; El: TPasRangeType; aContext: TPCUReaderContext); virtual;
+    procedure ReadArrayScope(Obj: TJSONObject; Scope: TPas2JSArrayScope; aContext: TPCUReaderContext); virtual;
     procedure ReadArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUReaderContext); virtual;
     procedure ReadArrayType(Obj: TJSONObject; El: TPasArrayType; aContext: TPCUReaderContext); virtual;
     procedure ReadFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUReaderContext); virtual;
     procedure ReadFileType(Obj: TJSONObject; El: TPasFileType; aContext: TPCUReaderContext); virtual;
     procedure ReadEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUReaderContext); virtual;
     procedure ReadEnumValue(Obj: TJSONObject; El: TPasEnumValue; aContext: TPCUReaderContext); virtual;
@@ -3067,7 +3069,7 @@ procedure TPCUWriter.WriteElType(Obj: TJSONObject; El: TPasElement;
   const PropName: string; aType: TPasType; aContext: TPCUWriterContext);
   const PropName: string; aType: TPasType; aContext: TPCUWriterContext);
 begin
 begin
   if aType=nil then exit;
   if aType=nil then exit;
-  if (aType.Name='') or (aType.Parent=El) then
+  if (aType.Name='') {or (aType.Parent=El)} then
     begin
     begin
     // anonymous type
     // anonymous type
     WriteElementProperty(Obj,El,PropName,aType,aContext);
     WriteElementProperty(Obj,El,PropName,aType,aContext);
@@ -4027,6 +4029,12 @@ begin
   WriteExpr(Obj,El,'Range',El.RangeExpr,aContext);
   WriteExpr(Obj,El,'Range',El.RangeExpr,aContext);
 end;
 end;
 
 
+procedure TPCUWriter.WriteArrayTypeScope(Obj: TJSONObject;
+  Scope: TPas2JSArrayScope; aContext: TPCUWriterContext);
+begin
+  WriteIdentifierScope(Obj,Scope,aContext);
+end;
+
 procedure TPCUWriter.WriteArrayType(Obj: TJSONObject; El: TPasArrayType;
 procedure TPCUWriter.WriteArrayType(Obj: TJSONObject; El: TPasArrayType;
   aContext: TPCUWriterContext);
   aContext: TPCUWriterContext);
 begin
 begin
@@ -4036,6 +4044,8 @@ begin
   if El.PackMode<>pmNone then
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
   WriteElType(Obj,El,'ElType',El.ElType,aContext);
   WriteElType(Obj,El,'ElType',El.ElType,aContext);
+  if El.CustomData is TPas2JSArrayScope then
+    WriteArrayTypeScope(Obj,TPas2JSArrayScope(El.CustomData),aContext);
 end;
 end;
 
 
 procedure TPCUWriter.WriteFileType(Obj: TJSONObject; El: TPasFileType;
 procedure TPCUWriter.WriteFileType(Obj: TJSONObject; El: TPasFileType;
@@ -5067,7 +5077,7 @@ begin
   if RefEl is TPasType then
   if RefEl is TPasType then
     begin
     begin
     El.ElType:=TPasType(RefEl);
     El.ElType:=TPasType(RefEl);
-    if RefEl.Parent<>El then
+    if RefEl.Name<>'' then
       RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArrayType.ElType'){$ENDIF};
       RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArrayType.ElType'){$ENDIF};
     end
     end
   else
   else
@@ -8281,15 +8291,31 @@ begin
   El.RangeExpr:=TBinaryExpr(Expr);
   El.RangeExpr:=TBinaryExpr(Expr);
 end;
 end;
 
 
+procedure TPCUReader.ReadArrayScope(Obj: TJSONObject; Scope: TPas2JSArrayScope;
+  aContext: TPCUReaderContext);
+begin
+  ReadIdentifierScope(Obj,Scope,aContext);
+  Scope.GenericStep:=psgsImplementationParsed;
+end;
+
 procedure TPCUReader.ReadArrayType(Obj: TJSONObject; El: TPasArrayType;
 procedure TPCUReader.ReadArrayType(Obj: TJSONObject; El: TPasArrayType;
   aContext: TPCUReaderContext);
   aContext: TPCUReaderContext);
+var
+  Scope: TPas2JSArrayScope;
 begin
 begin
   ReadPasElement(Obj,El,aContext);
   ReadPasElement(Obj,El,aContext);
   ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   ReadPasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
   ReadPasExprArray(Obj,El,'Ranges',El.Ranges,aContext);
   if El.PackMode<>pmNone then
   if El.PackMode<>pmNone then
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
     Obj.Add('Packed',PCUPackModeNames[El.PackMode]);
+  if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+    begin
+    Scope:=TPas2JSArrayScope(Resolver.CreateScope(El,TPas2JSArrayScope));
+    El.CustomData:=Scope;
+    ReadArrayScope(Obj,Scope,aContext);
+    end;
   ReadElType(Obj,'ElType',El,@Set_ArrayType_ElType,aContext);
   ReadElType(Obj,'ElType',El,@Set_ArrayType_ElType,aContext);
+
   ReadSpecializations(Obj,El);
   ReadSpecializations(Obj,El);
 end;
 end;
 
 

+ 34 - 0
packages/pastojs/tests/tcfiler.pas

@@ -226,6 +226,7 @@ type
     procedure TestPC_Specialize_LocalTypeInUnit;
     procedure TestPC_Specialize_LocalTypeInUnit;
     procedure TestPC_Specialize_ClassForward;
     procedure TestPC_Specialize_ClassForward;
     procedure TestPC_InlineSpecialize_LocalTypeInUnit;
     procedure TestPC_InlineSpecialize_LocalTypeInUnit;
+    procedure TestPC_Specialize_Array;
     // ToDo: specialize extern generic type in unit interface
     // ToDo: specialize extern generic type in unit interface
     // ToDo: specialize extern generic type in unit implementation
     // ToDo: specialize extern generic type in unit implementation
     // ToDo: specialize extern generic type in proc decl
     // ToDo: specialize extern generic type in proc decl
@@ -3440,6 +3441,39 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_Specialize_Array;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TArray<T> = array of T;',
+  'var',
+  '  da: TArray<double>;',
+  'procedure Fly;',
+  'implementation',
+  'var wa: TArray<word>;',
+  'procedure Run;',
+  'var',
+  '  sha: TArray<shortint>;',
+  '  ba: TArray<boolean>;',
+  'begin',
+  '  sha[1]:=3;',
+  '  wa[2]:=4;',
+  '  ba[3]:=true;',
+  'end;',
+  'procedure Fly;',
+  'var la: TArray<longint>;',
+  'begin',
+  '  la[4]:=5;',
+  '  Run;',
+  'end;',
+  'begin',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
 begin
   AddModuleWithIntfImplSrc('unit2.pp',
   AddModuleWithIntfImplSrc('unit2.pp',