pastojs: filer: fixed canonicalset

git-svn-id: trunk@38544 -

packages/pastojs/src/pas2jsfiler.pp

@@ -815,6 +815,7 @@ type
     procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
     procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
@@ -998,6 +999,8 @@ function crc32(crc: cardinal; buf: Pbyte; len: cardinal): cardinal;
 function ModeSwitchToInt(ms: TModeSwitch): byte;
 function StrToPasIdentifierKind(const s: string): TPasIdentifierKind;
 
+procedure GrowIdToRefsArray(var IdToRefsArray: TPCUFilerElementRefArray; Id: integer);
+
 function dbgmem(const s: string): string; overload;
 function dbgmem(p: PChar; Cnt: integer): string; overload;
 
@@ -1336,6 +1339,22 @@ begin
   Result:=pikNone;
 end;
 
+procedure GrowIdToRefsArray(var IdToRefsArray: TPCUFilerElementRefArray; Id: integer);
+var
+  OldCapacity, NewCapacity: Integer;
+begin
+  OldCapacity:=length(IdToRefsArray);
+  if Id>=OldCapacity then
+    begin
+    // grow
+    NewCapacity:=OldCapacity;
+    if NewCapacity=0 then NewCapacity:=100;
+    while NewCapacity<Id+1 do NewCapacity:=NewCapacity*2;
+    SetLength(IdToRefsArray,NewCapacity);
+    FillByte(IdToRefsArray[OldCapacity],SizeOf(Pointer)*(NewCapacity-OldCapacity),0);
+    end;
+end;
+
 function dbgmem(const s: string): string;
 begin
   if s='' then exit('');
@@ -1547,7 +1566,7 @@ begin
   C:=Expr.ClassType;
   if C=TArrayValues then exit(false);
   if C=TRecordValues then exit(false);
-  Result:=true;
+  Result:=not Resolver.ExprEvaluator.IsSimpleExpr(Expr);
 end;
 
 function TPCUFiler.GetSrcCheckSum(aFilename: string): TPCUSourceFileChecksum;
@@ -2334,7 +2353,7 @@ var
   SubObj: TJSONObject;
 begin
   if El=nil then exit;
-  if Parent<>El.Parent then
+  if (Parent<>El.Parent) then
     RaiseMsg(20180208221751,El,GetObjName(Parent)+'<>'+GetObjName(El.Parent));
   SubObj:=TJSONObject.Create;
   Obj.Add(PropName,SubObj);
@@ -2683,7 +2702,6 @@ procedure TPCUWriter.WriteExprCustomData(Obj: TJSONObject; Expr: TPasExpr;
 var
   Ref: TResolvedReference;
 begin
-  if Expr.CustomData=nil then exit;
   if Expr.CustomData is TResolvedReference then
     begin
     Ref:=TResolvedReference(Expr.CustomData);
@@ -2936,7 +2954,7 @@ procedure TPCUWriter.WriteEnumTypeScope(Obj: TJSONObject;
   Scope: TPasEnumTypeScope; aContext: TPCUWriterContext);
 begin
   WriteIdentifierScope(Obj,Scope,aContext);
-  WriteElementProperty(Obj,Scope.Element,'CanonicalSet',Scope.CanonicalSet,aContext);
+  WriteElType(Obj,Scope.Element,'CanonicalSet',Scope.CanonicalSet,aContext);
 end;
 
 procedure TPCUWriter.WriteEnumType(Obj: TJSONObject; El: TPasEnumType;
@@ -3958,6 +3976,22 @@ begin
     RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
+  Data: TObject);
+var
+  El: TPasEnumType absolute Data;
+  Scope: TPasEnumTypeScope;
+begin
+  if RefEl is TPasSetType then
+    begin
+    Scope:=El.CustomData as TPasEnumTypeScope;
+    Scope.CanonicalSet:=TPasSetType(RefEl);
+    RefEl.AddRef;
+    end
+  else
+    RaiseMsg(20180316215238,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_PropertyScope_AncestorProp(RefEl: TPasElement;
   Data: TObject);
 var
@@ -4145,7 +4179,6 @@ end;
 function TPCUReader.AddElReference(Id: integer; ErrorEl: TPasElement;
   El: TPasElement): TPCUFilerElementRef;
 var
-  NewCapacity, OldCapacity: Integer;
   Ref: TPCUFilerElementRef;
   RefItem: TPCUFilerPendingElRef;
   PendingElRef: TPCUReaderPendingElRef;
@@ -4153,16 +4186,10 @@ var
 begin
   if Id<=0 then
     RaiseMsg(20180207151233,ErrorEl);
-  OldCapacity:=length(FElementRefsArray);
-  if Id>=OldCapacity then
-    begin
-    // grow
-    NewCapacity:=OldCapacity;
-    if NewCapacity=0 then NewCapacity:=16;
-    while NewCapacity<Id+1 do NewCapacity:=NewCapacity*2;
-    SetLength(FElementRefsArray,NewCapacity);
-    FillByte(FElementRefsArray[OldCapacity],SizeOf(Pointer)*(NewCapacity-OldCapacity),0);
-    end;
+  if Id>1000000 then
+    RaiseMsg(20180316090216,ErrorEl,IntToStr(Id));
+  if Id>=length(FElementRefsArray) then
+    GrowIdToRefsArray(FElementRefsArray,Id);
 
   Ref:=FElementRefsArray[Id];
   {$IFDEF VerbosePCUFiler}
@@ -4750,12 +4777,16 @@ var
   SubObj: TJSONObject;
   Intf: TInterfaceSection;
   Name: string;
+  Ref: TPCUFilerElementRef;
 begin
   {$IFDEF VerbosePCUFiler}
   writeln('TPCUReader.ReadExtRefs ',GetObjName(El));
   {$ENDIF}
   if ReadInteger(Obj,'Id',Id,El) then
-    AddElReference(Id,El,El);
+    begin
+    Ref:=AddElReference(Id,El,El);
+    Ref.Obj:=Obj;
+    end;
   if ReadArray(Obj,'El',Arr,El) then
     begin
     if El is TPasDeclarations then
@@ -5465,6 +5496,7 @@ begin
 
   if not ReadBoolean(Obj,'Eval',NeedEvalValue,Expr) then
     NeedEvalValue:=GetDefaultExprHasEvalValue(Expr);
+  //writeln('TPCUReader.ReadExprCustomData ',Expr.FullPath,' ',GetObjName(Expr),' NeedEvalValue=',NeedEvalValue);
   if NeedEvalValue then
     begin
     Value:=Resolver.Eval(Expr,[refAutoConst]);
@@ -6027,8 +6059,7 @@ end;
 procedure TPCUReader.ReadEnumTypeScope(Obj: TJSONObject;
   Scope: TPasEnumTypeScope; aContext: TPCUReaderContext);
 begin
-  Scope.CanonicalSet:=TPasSetType(ReadElementProperty(
-                        Obj,Scope.Element,'CanonicalSet',TPasSetType,aContext));
+  ReadElType(Obj,'CanonicalSet',Scope.Element,@Set_EnumTypeScope_CanonicalSet,aContext);
   ReadIdentifierScope(Obj,Scope,aContext);
 end;
 

packages/pastojs/tests/tcfiler.pas

@@ -137,8 +137,11 @@ type
     procedure TestPC_Var;
     procedure TestPC_Enum;
     procedure TestPC_Set;
+    procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_Record;
     procedure TestPC_JSValue;
+    procedure TestPC_Array;
+    procedure TestPC_ArrayOfAnonymous;
     procedure TestPC_Proc;
     procedure TestPC_Proc_Nested;
     procedure TestPC_Proc_LocalConst;
@@ -671,7 +674,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredEnumTypeScope(const Path: string;
   Orig, Rest: TPasEnumTypeScope);
 begin
-  CheckRestoredElement(Path+'.CanonicalSet',Orig.CanonicalSet,Rest.CanonicalSet);
+  CheckRestoredReference(Path+'.CanonicalSet',Orig.CanonicalSet,Rest.CanonicalSet);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
 
@@ -963,7 +966,9 @@ var
   C: TClass;
   AModule: TPasModule;
 begin
+  //writeln('TCustomTestPrecompile.CheckRestoredElement START Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
   if not CheckRestoredObject(Path,Orig,Rest) then exit;
+  //writeln('TCustomTestPrecompile.CheckRestoredElement CheckRestoredObject Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
 
   AModule:=Orig.GetModule;
   if AModule<>Module then
@@ -979,8 +984,10 @@ begin
     Fail(Path+'.Hints');
   AssertEquals(Path+'.HintMessage',Orig.HintMessage,Rest.HintMessage);
 
+  //writeln('TCustomTestPrecompile.CheckRestoredElement Checking Parent... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
   CheckRestoredReference(Path+'.Parent',Orig.Parent,Rest.Parent);
 
+  //writeln('TCustomTestPrecompile.CheckRestoredElement Checking CustomData... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
   CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData);
 
   C:=Orig.ClassType;
@@ -1523,6 +1530,7 @@ begin
   '  AnoArr: array of longint = (1,2,3);',
   '  s: string = ''aaaäö'';',
   '  s2: string = ''😊'';', // 1F60A
+  '  a,b: longint;',
   'implementation']);
   WriteReadUnit;
 end;
@@ -1554,8 +1562,8 @@ begin
   '  TEnumRg = green..blue;',
   '  TEnumAlias = TEnum;', // alias
   '  TSetOfEnum = set of TEnum;',
-  '  TSetOfAnoEnum = set of TEnum;', // anonymous enumtype
   '  TSetOfEnumRg = set of TEnumRg;',
+  '  TSetOfDir = set of (west,east);',
   'var',
   '  Empty: TSetOfEnum = [];', // empty set lit
   '  All: TSetOfEnum = [low(TEnum)..pred(high(TEnum)),high(TEnum)];', // full set lit, range in set
@@ -1563,6 +1571,17 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_SetOfAnonymousEnumType;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TSetOfDir = set of (west,east);',
+  'implementation']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Record;
 begin
   StartUnit(false);
@@ -1593,6 +1612,32 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Array;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TEnum = (red,green);',
+  '  TArrInt = array of longint;',
+  '  TArrInt2 = array[1..2] of longint;',
+  '  TArrEnum1 = array[red..green] of longint;',
+  '  TArrEnum2 = array[TEnum] of longint;',
+  'implementation']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_ArrayOfAnonymous;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'var',
+  '  a: array of pointer;',
+  'implementation']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Proc;
 begin
   StartUnit(false);
@@ -1600,6 +1645,8 @@ begin
   'interface',
   '  function Abs(d: double): double; external name ''Math.Abs'';',
   '  function GetIt(d: double): double;',
+  '  procedure DoArgs(const a; var b: array of char; out c: jsvalue); inline;',
+  '  procedure DoMulti(a,b: byte);',
   'implementation',
   'var k: double;',
   'function GetIt(d: double): double;',
@@ -1608,6 +1655,12 @@ begin
   '  j:=Abs(d+k);',
   '  Result:=j;',
   'end;',
+  'procedure DoArgs(const a; var b: array of char; out c: jsvalue); inline;',
+  'begin',
+  'end;',
+  'procedure DoMulti(a,b: byte);',
+  'begin',
+  'end;',
   'procedure NotUsed;',
   'begin',
   'end;',