pastojs: changed constraints to TPasElementArray, changed TInlineSpecializeExpr to NameExpr:TPasExpr and Params:TFPList

git-svn-id: trunk@43021 -

packages/pastojs/src/fppas2js.pp

@@ -6859,21 +6859,8 @@ end;
 
 function TPasToJSConverter.ConvertInlineSpecializeExpr(
   El: TInlineSpecializeExpr; AContext: TConvertContext): TJSElement;
-var
-  aResolver: TPas2JSResolver;
-  DestType: TPasType;
-  GenType: TPasGenericType;
-  Name: String;
 begin
-  aResolver:=AContext.Resolver;
-  DestType:=aResolver.ResolveAliasType(El.DestType);
-  if not (DestType is TPasGenericType) then
-    RaiseNotSupported(El,AContext,20190826143203,GetObjPath(DestType));
-  GenType:=TPasGenericType(DestType);
-  if (GenType.GenericTemplateTypes<>nil) and (GenType.GenericTemplateTypes.Count>0) then
-    RaiseNotSupported(El,AContext,20190826143508,GetObjName(GenType));
-  Name:=CreateReferencePath(GenType,AContext,rpkPathAndName);
-  Result:=CreatePrimitiveDotExpr(Name,El);
+  Result:=ConvertElement(El.NameExpr,AContext);
 end;
 
 function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;

packages/pastojs/src/fppjssrcmap.pp

@@ -148,7 +148,7 @@ begin
   //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine,',Col=',FSrcColumn-1);
 
   SrcMap.AddMapping(CurLine,Max(0,CurColumn-1),
-    FSrcFilename,FSrcLine,Max(0,FSrcColumn-1));
+    FSrcFilename,Max(0,FSrcLine),Max(0,FSrcColumn-1));
 
   if (CurElement is TJSLiteral)
       and (TJSLiteral(CurElement).Value.CustomValue<>'') then

packages/pastojs/src/pas2jscompiler.pp

@@ -15,7 +15,6 @@ Compiler-ToDos:
   Warn if -Ju and -Fu intersect
   -Fa<x>[,y] (for a program) load units <x> and [y] before uses is parsed
   Add Windows macros, see InitMacros.
-  add options for names of globals like 'pas' and 'rtl'
 }
 unit Pas2jsCompiler;
 

packages/pastojs/src/pas2jsfiler.pp

@@ -723,6 +723,9 @@ type
     procedure WriteElementList(Obj: TJSONObject; Parent: TPasElement;
       const PropName: string; ListOfElements: TFPList; aContext: TPCUWriterContext;
       ReferencesAllowed: boolean = false); virtual;
+    procedure WriteElementArray(Obj: TJSONObject; Parent: TPasElement;
+      const PropName: string; ArrOfElements: TPasElementArray; aContext: TPCUWriterContext;
+      ReferencesAllowed: boolean = false); virtual;
     procedure WriteElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
     procedure WriteElType(Obj: TJSONObject; El: TPasElement; const PropName: string; aType: TPasType; aContext: TPCUWriterContext); virtual;
     procedure WriteVarModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TVariableModifiers); virtual;
@@ -826,6 +829,15 @@ type
     AddRef: TPCUAddRef;
   end;
 
+  { TPCUReaderPendingElArrRef }
+
+  TPCUReaderPendingElArrRef = class(TPCUFilerPendingElRef)
+  public
+    Arr: TPasElementArray;
+    Index: integer;
+    AddRef: TPCUAddRef;
+  end;
+
   { TPCUReaderPendingIdentifierScope }
 
   TPCUReaderPendingIdentifierScope = class
@@ -844,7 +856,6 @@ type
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
-    procedure Set_InlineSpecializeExpr_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_FileType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
@@ -891,6 +902,8 @@ type
       Data: TObject; ErrorEl: TPasElement); virtual;
     procedure PromiseSetElListReference(Id: integer; List: TFPList; Index: integer;
       AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
+    procedure PromiseSetElArrReference(Id: integer; Arr: TPasElementArray; Index: integer;
+      AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
     procedure ReadHeaderMagic(Obj: TJSONObject); virtual;
     procedure ReadHeaderVersion(Obj: TJSONObject); virtual;
     procedure ReadGUID(Obj: TJSONObject); virtual;
@@ -923,6 +936,9 @@ type
     procedure ReadElementList(Obj: TJSONObject; Parent: TPasElement;
       const PropName: string; ListOfElements: TFPList; AddRef: TPCUAddRef;
       aContext: TPCUReaderContext); virtual;
+    procedure ReadElementArray(Obj: TJSONObject; Parent: TPasElement;
+      const PropName: string; var ArrOfElements: TPasElementArray; AddRef: TPCUAddRef;
+      aContext: TPCUReaderContext); virtual;
     procedure ReadElType(Obj: TJSONObject; const PropName: string; El: TPasElement;
       const Setter: TOnSetElReference; aContext: TPCUReaderContext); virtual;
     function ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
@@ -2750,6 +2766,36 @@ begin
     end;
 end;
 
+procedure TPCUWriter.WriteElementArray(Obj: TJSONObject; Parent: TPasElement;
+  const PropName: string; ArrOfElements: TPasElementArray;
+  aContext: TPCUWriterContext; ReferencesAllowed: boolean);
+var
+  Arr: TJSONArray;
+  i: Integer;
+  SubObj: TJSONObject;
+  Item: TPasElement;
+begin
+  if length(ArrOfElements)=0 then exit;
+  Arr:=TJSONArray.Create;
+  Obj.Add(PropName,Arr);
+  for i:=0 to length(ArrOfElements)-1 do
+    begin
+    Item:=ArrOfElements[i];
+    if Item.Parent<>Parent then
+      begin
+      if not ReferencesAllowed then
+        RaiseMsg(20180209191444,Item,GetObjName(Parent)+'<>'+GetObjName(Item.Parent));
+      AddReferenceToArray(Arr,Item);
+      end
+    else
+      begin
+      SubObj:=TJSONObject.Create;
+      Arr.Add(SubObj);
+      WriteElement(SubObj,Item,aContext);
+      end;
+    end;
+end;
+
 procedure TPCUWriter.WriteElement(Obj: TJSONObject;
   El: TPasElement; aContext: TPCUWriterContext);
 var
@@ -3298,7 +3344,7 @@ begin
     TemplObj:=TJSONObject.Create;
     Arr.Add(TemplObj);
     TemplObj.Add('Name',Templ.Name);
-    WritePasExprArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext);
+    WriteElementArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext,true);
     end;
 end;
 
@@ -3328,7 +3374,8 @@ procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
 begin
   WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
-  WriteElType(Obj,Expr,'Dest',Expr.DestType,aContext);
+  WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
+  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -3782,7 +3829,7 @@ begin
           TemplObj:=TJSONObject.Create;
           TemplArr.Add(TemplObj);
           TemplObj.Add('Name',GenType.Name);
-          WritePasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          WriteElementArray(TemplObj,El,'Constraints',GenType.Constraints,aContext,true);
           end;
         end;
       end;
@@ -4249,21 +4296,6 @@ begin
     RaiseMsg(20180211121757,El,GetObjName(RefEl));
 end;
 
-procedure TPCUReader.Set_InlineSpecializeExpr_DestType(RefEl: TPasElement;
-  Data: TObject);
-var
-  El: TInlineSpecializeExpr absolute Data;
-begin
-  if RefEl is TPasSpecializeType then
-    begin
-    El.DestType:=TPasSpecializeType(RefEl);
-    if RefEl.Parent<>El then
-      RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.DestType'){$ENDIF};
-    end
-  else
-    RaiseMsg(20190815192420,El,GetObjName(RefEl));
-end;
-
 procedure TPCUReader.Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
 var
   El: TPasArrayType absolute Data;
@@ -4771,6 +4803,7 @@ var
   RefItem: TPCUFilerPendingElRef;
   PendingElRef: TPCUReaderPendingElRef;
   PendingElListRef: TPCUReaderPendingElListRef;
+  PendingElArrRef: TPCUReaderPendingElArrRef;
   {$IF defined(VerbosePCUFiler) or defined(memcheck)}
   Node: TAVLTreeNode;
   {$ENDIF}
@@ -4840,6 +4873,13 @@ begin
           if PendingElListRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
             Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElListRef.AddRef){$ENDIF};
           end
+        else if RefItem is TPCUReaderPendingElArrRef then
+          begin
+          PendingElArrRef:=TPCUReaderPendingElArrRef(RefItem);
+          PendingElArrRef.Arr[PendingElArrRef.Index]:=Ref.Element;
+          if PendingElArrRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
+            Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElArrRef.AddRef){$ENDIF};
+          end
         else
           RaiseMsg(20180207153056,ErrorEl,RefItem.ClassName);
         Ref.Pending:=RefItem.Next;
@@ -4901,6 +4941,33 @@ begin
     end;
 end;
 
+procedure TPCUReader.PromiseSetElArrReference(Id: integer;
+  Arr: TPasElementArray; Index: integer; AddRef: TPCUAddRef;
+  ErrorEl: TPasElement);
+var
+  Ref: TPCUFilerElementRef;
+  PendingItem: TPCUReaderPendingElArrRef;
+begin
+  Ref:=AddElReference(Id,ErrorEl,nil);
+  if Ref.Element<>nil then
+    begin
+    // element was already created -> set list item immediately
+    Arr[Index]:=Ref.Element;
+    if AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
+      Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(AddRef){$ENDIF};
+    end
+  else
+    begin
+    // element was not yet created -> store
+    PendingItem:=TPCUReaderPendingElArrRef.Create;
+    PendingItem.Arr:=Arr;
+    PendingItem.Index:=Index;
+    PendingItem.AddRef:=AddRef;
+    PendingItem.ErrorEl:=ErrorEl;
+    Ref.AddPending(PendingItem);
+    end;
+end;
+
 procedure TPCUReader.ReadHeaderMagic(Obj: TJSONObject);
 begin
   {$IFDEF VerbosePCUFiler}
@@ -6006,7 +6073,7 @@ begin
       // reference
       Id:=Data.AsInteger;
       ListOfElements.Add(nil);
-      PromiseSetElListReference(Id,ListOfElements,ListOfElements.Count-1,AddRef,Parent);
+      PromiseSetElListReference(Id,ListOfElements,i,AddRef,Parent);
       end
     else if Data is TJSONObject then
       begin
@@ -6019,6 +6086,40 @@ begin
     end;
 end;
 
+procedure TPCUReader.ReadElementArray(Obj: TJSONObject; Parent: TPasElement;
+  const PropName: string; var ArrOfElements: TPasElementArray;
+  AddRef: TPCUAddRef; aContext: TPCUReaderContext);
+var
+  Arr: TJSONArray;
+  i, Id: Integer;
+  Data: TJSONData;
+  SubObj: TJSONObject;
+  SubEl: TPasElement;
+begin
+  if not ReadArray(Obj,PropName,Arr,Parent) then exit;
+  for i:=0 to Arr.Count-1 do
+    begin
+    Data:=Arr[i];
+    if Data is TJSONIntegerNumber then
+      begin
+      // reference
+      Id:=Data.AsInteger;
+      SetLength(ArrOfElements,i+1);
+      ArrOfElements[i]:=nil;
+      PromiseSetElArrReference(Id,ArrOfElements,i,AddRef,Parent);
+      end
+    else if Data is TJSONObject then
+      begin
+      SubObj:=TJSONObject(Data);
+      SubEl:=ReadElement(SubObj,Parent,aContext);
+      SetLength(ArrOfElements,i+1);
+      ArrOfElements[i]:=SubEl;
+      end
+    else
+      RaiseMsg(20180210201001,Parent,'['+IntToStr(i)+'] is '+GetObjName(Data));
+    end;
+end;
+
 procedure TPCUReader.ReadElType(Obj: TJSONObject; const PropName: string;
   El: TPasElement; const Setter: TOnSetElReference; aContext: TPCUReaderContext
   );
@@ -6691,7 +6792,9 @@ begin
       RaiseMsg(20190720224130,Parent,IntToStr(i));
     GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,Parent));
     GenericTemplateTypes.Add(GenType);
-    ReadPasExprArray(TemplObj,Parent,'Constraints',GenType.Constraints,aContext);
+    ReadElementArray(TemplObj,Parent,'Constraints',GenType.Constraints,
+      {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+      aContext);
     end;
 end;
 
@@ -6723,7 +6826,10 @@ procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
 begin
   Expr.Kind:=pekSpecialize;
-  ReadElType(Obj,'Dest',Expr,@Set_InlineSpecializeExpr_DestType,aContext);
+  Expr.NameExpr:=ReadExpr(Obj,Expr,'Name',aContext);
+  ReadElementList(Obj,Expr,'Params',Expr.Params,
+    {$IFDEF CheckPasTreeRefCount}'TInlineSpecializeExpr.Params'{$ELSE}true{$ENDIF},
+    aContext);
 end;
 
 procedure TPCUReader.ReadRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -7512,7 +7618,9 @@ begin
             RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
           GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
           Templates.Add(GenType);
-          ReadPasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          ReadElementArray(TemplObj,El,'Constraints',GenType.Constraints,
+             {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+             aContext);
           end;
         end;
       end;

packages/pastojs/tests/tcfiler.pas

@@ -83,6 +83,7 @@ type
     procedure CheckRestoredAnalyzerElement(const Path: string; Orig, Rest: TPasElement); virtual;
     procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
     procedure CheckRestoredElementList(const Path: string; Orig, Rest: TFPList); virtual;
+    procedure CheckRestoredElementArray(const Path: string; Orig, Rest: TPasElementArray); virtual;
     procedure CheckRestoredElRefList(const Path: string; OrigParent: TPasElement;
       Orig: TFPList; RestParent: TPasElement; Rest: TFPList; AllowInSitu: boolean); virtual;
     procedure CheckRestoredPasExpr(const Path: string; Orig, Rest: TPasExpr); virtual;
@@ -100,6 +101,7 @@ type
     procedure CheckRestoredPointerType(const Path: string; Orig, Rest: TPasPointerType); virtual;
     procedure CheckRestoredSpecializedType(const Path: string; Orig, Rest: TPasSpecializeType); virtual;
     procedure CheckRestoredInlineSpecializedExpr(const Path: string; Orig, Rest: TInlineSpecializeExpr); virtual;
+    procedure CheckRestoredGenericTemplateType(const Path: string; Orig, Rest: TPasGenericTemplateType); virtual;
     procedure CheckRestoredRangeType(const Path: string; Orig, Rest: TPasRangeType); virtual;
     procedure CheckRestoredArrayType(const Path: string; Orig, Rest: TPasArrayType); virtual;
     procedure CheckRestoredFileType(const Path: string; Orig, Rest: TPasFileType); virtual;
@@ -1130,6 +1132,8 @@ begin
     CheckRestoredSpecializedType(Path,TPasSpecializeType(Orig),TPasSpecializeType(Rest))
   else if C=TInlineSpecializeExpr then
     CheckRestoredInlineSpecializedExpr(Path,TInlineSpecializeExpr(Orig),TInlineSpecializeExpr(Rest))
+  else if C=TPasGenericTemplateType then
+    CheckRestoredGenericTemplateType(Path,TPasGenericTemplateType(Orig),TPasGenericTemplateType(Rest))
   else if C=TPasRangeType then
     CheckRestoredRangeType(Path,TPasRangeType(Orig),TPasRangeType(Rest))
   else if C=TPasArrayType then
@@ -1219,6 +1223,29 @@ begin
     end;
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredElementArray(const Path: string;
+  Orig, Rest: TPasElementArray);
+var
+  OrigItem, RestItem: TPasElement;
+  i: Integer;
+  SubPath: String;
+begin
+  AssertEquals(Path+'.length',length(Orig),length(Rest));
+  for i:=0 to length(Orig)-1 do
+    begin
+    SubPath:=Path+'['+IntToStr(i)+']';
+    OrigItem:=Orig[i];
+    if not (OrigItem is TPasElement) then
+      Fail(SubPath+' Orig='+GetObjName(OrigItem));
+    RestItem:=Rest[i];
+    if not (RestItem is TPasElement) then
+      Fail(SubPath+' Rest='+GetObjName(RestItem));
+    //writeln('TCustomTestPrecompile.CheckRestoredElementList ',GetObjName(OrigItem),' ',GetObjName(RestItem));
+    SubPath:=Path+'['+IntToStr(i)+']"'+TPasElement(OrigItem).Name+'"';
+    CheckRestoredElement(SubPath,TPasElement(OrigItem),TPasElement(RestItem));
+    end;
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredElRefList(const Path: string;
   OrigParent: TPasElement; Orig: TFPList; RestParent: TPasElement;
   Rest: TFPList; AllowInSitu: boolean);
@@ -1360,7 +1387,14 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredInlineSpecializedExpr(
   const Path: string; Orig, Rest: TInlineSpecializeExpr);
 begin
-  CheckRestoredElement(Path+'.DestType',Orig.DestType,Rest.DestType);
+  CheckRestoredElement(Path+'.Name',Orig.NameExpr,Rest.NameExpr);
+  CheckRestoredElementList(Path+'.Params',Orig.Params,Rest.Params);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredGenericTemplateType(
+  const Path: string; Orig, Rest: TPasGenericTemplateType);
+begin
+  CheckRestoredElementArray(Path+'.Constraints',Orig.Constraints,Rest.Constraints);
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredRangeType(const Path: string;