pastojs: writer: external reference queue

git-svn-id: trunk@38564 -

packages/fcl-passrc/src/pasresolver.pp

@@ -191,6 +191,7 @@ ToDo:
 - array+array
 - pointer type, ^type, @ operator, [] operator
 - type alias type
+- set of CharRange
 - object
 - interfaces
   - implements, supports

packages/pastojs/src/fppas2js.pp

@@ -10052,10 +10052,10 @@ begin
   if Value=nil then
     RaiseNotSupported(El,AContext,20170910211948);
   case Value.Kind of
+  revkNil:
+    Result:=CreateLiteralNull(El);
   revkBool:
     Result:=CreateLiteralBoolean(El,TResEvalBool(Value).B);
-  revkEnum:
-    Result:=CreateReferencePathExpr(TResEvalEnum(Value).GetEnumValue,AContext);
   revkInt:
     Result:=CreateLiteralNumber(El,TResEvalInt(Value).Int);
   revkUInt:
@@ -10066,6 +10066,8 @@ begin
     Result:=CreateLiteralString(El,TResEvalString(Value).S);
   revkUnicodeString:
     Result:=CreateLiteralJSString(El,TResEvalUTF16(Value).S);
+  revkEnum:
+    Result:=CreateReferencePathExpr(TResEvalEnum(Value).GetEnumValue,AContext);
   revkSetOfInt:
     if Value.IdentEl is TPasExpr then
       Result:=ConvertElement(Value.IdentEl,AContext)

packages/pastojs/src/pas2jscompiler.pp

@@ -262,6 +262,7 @@ type
     procedure HandleEParserError(E: EParserError);
     procedure HandleEPasResolve(E: EPasResolve);
     procedure HandleEPas2JS(E: EPas2JS);
+    procedure HandleEPCUReader(E: EPas2JsReadError);
     procedure HandleUnknownException(E: Exception);
     procedure HandleException(E: Exception);
     procedure DoLogMsgAtEl(MsgType: TMessageType; const Msg: string;
@@ -1051,6 +1052,20 @@ begin
   Compiler.Terminate(ExitCodeConverterError);
 end;
 
+procedure TPas2jsCompilerFile.HandleEPCUReader(E: EPas2JsReadError);
+var
+  Reader: TPCUCustomReader;
+begin
+  if E.Owner is TPCUCustomReader then
+  begin
+    Reader:=TPCUCustomReader(E.Owner);
+    Log.Log(mtError,E.Message);
+  end else begin
+    Log.Log(mtError,E.Message);
+  end;
+  Compiler.Terminate(ExitCodePCUError);
+end;
+
 procedure TPas2jsCompilerFile.HandleUnknownException(E: Exception);
 begin
   if not (E is ECompilerTerminate) then
@@ -1073,6 +1088,8 @@ begin
     HandleEPasResolve(EPasResolve(E))
   else if E is EPas2JS then
     HandleEPas2JS(EPas2JS(E))
+  else if E is EPas2JsReadError then
+    HandleEPCUReader(EPas2JsReadError(E))
   else if E is EFileNotFoundError then
   begin
     Log.Log(mtFatal,E.Message);

packages/pastojs/src/pas2jsfiler.pp

@@ -14,7 +14,12 @@
  **********************************************************************
 
 Abstract:
-  Write and read a precompiled module (pcu).
+  Write and read a precompiled module (pcu, gzipped json).
+
+- Built-In symbols are collected in one array.
+- symbols of this module are stored in a tree
+- external references are stored in used module trees. They can refer
+  recursively to other external references, so they are collected in a Queue.
 
 Works:
 - store used source files and checksums
@@ -191,7 +196,7 @@ const
     'ObjectChecks'
     );
 
-  PCUDefaultConverterOptions: TPasToJsConverterOptions = [coStoreImplJS];
+  PCUDefaultConverterOptions: TPasToJsConverterOptions = [coUseStrict];
   PCUConverterOptions: array[TPasToJsConverterOption] of string = (
     'LowerCase',
     'SwitchStatement',
@@ -539,6 +544,7 @@ type
     Pending: TPCUFilerPendingElRef;
     Obj: TJSONObject;
     Elements: TJSONArray; // for external references
+    NextNewExt: TPCUFilerElementRef; // next new external reference
     procedure AddPending(Item: TPCUFilerPendingElRef);
     procedure Clear;
     destructor Destroy; override;
@@ -570,6 +576,7 @@ type
     function GetDefaultExprHasEvalValue(Expr: TPasExpr): boolean; virtual;
     function GetSrcCheckSum(aFilename: string): TPCUSourceFileChecksum; virtual;
     function GetElementReference(El: TPasElement; AutoCreate: boolean = true): TPCUFilerElementRef;
+    function CreateElementRef(El: TPasElement): TPCUFilerElementRef; virtual;
     procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); virtual;
   public
     constructor Create; virtual;
@@ -645,6 +652,7 @@ type
     FInImplementation: boolean;
     FBuiltInSymbolsArr: TJSONArray;
   protected
+    FFirstNewExt, FLastNewExt: TPCUFilerElementRef; // not yet stored external references
     procedure RaiseMsg(Id: int64; const Msg: string = ''); override; overload;
     procedure ResolvePendingElRefs(Ref: TPCUFilerElementRef);
     function CheckElScope(El: TPasElement; NotNilId: int64; ScopeClass: TPasScopeClass): TPasScope; virtual;
@@ -654,6 +662,7 @@ type
     procedure AddReferenceToObj(Obj: TJSONObject; const PropName: string;
       El: TPasElement; WriteNil: boolean = false); virtual;
     procedure CreateElReferenceId(Ref: TPCUFilerElementRef); virtual;
+    function CreateElementRef(El: TPasElement): TPCUFilerElementRef; override;
     procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); override;
   protected
     procedure WriteHeaderMagic(Obj: TJSONObject); virtual;
@@ -1469,18 +1478,23 @@ end;
 procedure TPCUFiler.RaiseMsg(Id: int64; El: TPasElement; const Msg: string);
 var
   Path, s: String;
+  CurEl: TPasElement;
 begin
   Path:='';
-  while El<>nil do
+  CurEl:=El;
+  while CurEl<>nil do
     begin
     if Path<>'' then Path:='.'+Path;
-    s:=El.Name;
+    s:=CurEl.Name;
     if s='' then
-      s:=El.ClassName;
+      s:=CurEl.ClassName;
     Path:=s+Path;
-    El:=El.Parent;
+    CurEl:=CurEl.Parent;
     end;
-  RaiseMsg(Id,Path+': '+Msg);
+  s:=Path+': '+Msg;
+  if El.GetModule<>Resolver.RootElement then
+    s:='This='+Resolver.RootElement.Name+' El='+s;
+  RaiseMsg(Id,s);
 end;
 
 function TPCUFiler.GetDefaultMemberVisibility(El: TPasElement
@@ -1599,14 +1613,13 @@ begin
     end
   else if El is TPasUnresolvedSymbolRef then
     RaiseMsg(20180215190054,El,GetObjName(El));
+
   Node:=FElementRefs.FindKey(El,@CompareElWithPCUFilerElementRef);
   if Node<>nil then
     Result:=TPCUFilerElementRef(Node.Data)
   else if AutoCreate then
     begin
-    Result:=TPCUFilerElementRef.Create;
-    Result.Element:=El;
-    FElementRefs.Add(Result);
+    Result:=CreateElementRef(El);
     if IsBuiltIn then
       AddedBuiltInRef(Result);
     end
@@ -1614,6 +1627,13 @@ begin
     Result:=nil;
 end;
 
+function TPCUFiler.CreateElementRef(El: TPasElement): TPCUFilerElementRef;
+begin
+  Result:=TPCUFilerElementRef.Create;
+  Result.Element:=El;
+  FElementRefs.Add(Result);
+end;
+
 procedure TPCUFiler.AddedBuiltInRef(Ref: TPCUFilerElementRef);
 begin
   if Ref=nil then ;
@@ -1801,6 +1821,19 @@ begin
   Ref.Obj.Add('Id',Ref.Id);
 end;
 
+function TPCUWriter.CreateElementRef(El: TPasElement): TPCUFilerElementRef;
+begin
+  Result:=inherited CreateElementRef(El);
+  if El.GetModule<>Resolver.RootElement then
+    begin
+    if FFirstNewExt=nil then
+      FFirstNewExt:=Result
+    else
+      FLastNewExt.NextNewExt:=Result;
+    FLastNewExt:=Result;
+    end;
+end;
+
 procedure TPCUWriter.AddedBuiltInRef(Ref: TPCUFilerElementRef);
 var
   ModuleObj, Obj: TJSONObject;
@@ -2092,6 +2125,7 @@ begin
     WImplBlock(aModule.FinalizationSection,'Final');
     end;
 
+  //writeln('TPCUWriter.WriteModule WriteExternalReferences of implementation ',Resolver.RootElement.Name,' aContext.Section=',GetObjName(aContext.Section));
   WriteExternalReferences(aContext);
 end;
 
@@ -2318,7 +2352,14 @@ begin
 
   WriteDeclarations(Obj,Section,aContext);
   if Section is TInterfaceSection then
+    begin
+    if aContext.SectionObj<>Obj then
+      RaiseMsg(20180318112544,Section);
+    {$IFDEF VerbosePJUFiler}
+    //writeln('TPCUWriter.WriteSection WriteExternalReferences of Interface ',Section.FullPath);
+    {$ENDIF}
     WriteExternalReferences(aContext);
+    end;
 end;
 
 procedure TPCUWriter.WriteDeclarations(ParentJSON: TJSONObject;
@@ -3417,6 +3458,7 @@ begin
       begin
       if aContext.SectionObj=nil then
         RaiseMsg(20180314154428,El);
+      //writeln('TPCUWriter.WriteExternalReference ',Resolver.RootElement.Name,' Section=',GetObjName(aContext.Section),' IndirectUses=',El.Name);
       aContext.IndirectUsesArr:=TJSONArray.Create;
       aContext.SectionObj.Add('IndirectUses',aContext.IndirectUsesArr);
       end;
@@ -3429,25 +3471,26 @@ end;
 
 procedure TPCUWriter.WriteExternalReferences(aContext: TPCUWriterContext);
 var
-  Node: TAVLTreeNode;
   Ref: TPCUFilerElementRef;
   El: TPasElement;
-  Data: TObject;
 begin
-  Node:=FElementRefs.FindLowest;
-  while Node<>nil do
+   while FFirstNewExt<>nil do
     begin
-    Ref:=TPCUFilerElementRef(Node.Data);
-    Node:=FElementRefs.FindSuccessor(Node);
+    Ref:=FFirstNewExt;
+    FFirstNewExt:=Ref.NextNewExt;
+    if FFirstNewExt=nil then
+      FLastNewExt:=nil;
     if Ref.Pending=nil then
-      continue; // not used
+      continue; // not used, e.g. when a child is written, its parents are
+                // written too, which might still be in the queue
     El:=Ref.Element;
     //writeln('TPCUWriter.WriteExternalReferences ',GetObjName(El),' ',El.FullPath);
-    Data:=El.CustomData;
-    if Data is TResElDataBuiltInSymbol then
+    {$IF defined(VerbosePJUFiler) or defined(VerbosePCUFiler) or defined(VerboseUnitQueue)}
+    if El.CustomData is TResElDataBuiltInSymbol then
       RaiseMsg(20180314120554,El);
     if El.GetModule=Resolver.RootElement then
-      continue;
+      RaiseMsg(20180318120511,El);
+    {$ENDIF}
     // external element
     if Ref.Obj=nil then
       WriteExternalReference(El,aContext);
@@ -3468,6 +3511,8 @@ end;
 
 procedure TPCUWriter.Clear;
 begin
+  FFirstNewExt:=nil;
+  FLastNewExt:=nil;
   FInitialFlags:=nil;
   FElementIdCounter:=0;
   FSourceFilesSorted:=nil;

packages/pastojs/src/pas2jslogger.pp

@@ -37,6 +37,7 @@ const
   ExitCodeWriteError = 5;
   ExitCodeSyntaxError = 6;
   ExitCodeConverterError = 7;
+  ExitCodePCUError = 8;
 
 const
   DefaultLogMsgTypes = [mtFatal..mtDebug]; // by default show everything

packages/pastojs/tests/tcmodules.pas

@@ -295,6 +295,7 @@ type
     Procedure TestSet_Property;
     Procedure TestSet_EnumConst;
     Procedure TestSet_AnonymousEnumType;
+    Procedure TestSet_AnonymousEnumTypeChar; // ToDo
     Procedure TestSet_ConstEnum;
     Procedure TestSet_ConstChar;
     Procedure TestSet_ConstInt;
@@ -4209,6 +4210,38 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestSet_AnonymousEnumTypeChar;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  'type',
+  '  TAtoZ = ''A''..''Z'';',
+  '  TSetOfAZ = set of TAtoZ;',
+  'var',
+  '  c: char;',
+  '  a: TAtoZ;',
+  '  s: TSetOfAZ = [''P'',''A''];',
+  '  i: longint;',
+  'begin',
+  '  Include(s,''S'');',
+  '  Include(s,c);',
+  '  Include(s,a);',
+  '  c:=low(TAtoZ);',
+  '  i:=ord(low(TAtoZ));',
+  '  a:=high(TAtoZ);',
+  '  a:=high(TSetOfAtoZ);',
+  '  s:=[a,c,''M''];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestSet_AnonymousEnumTypeChar',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestSet_ConstEnum;
 begin
   StartProgram(false);
@@ -13620,30 +13653,33 @@ end;
 procedure TTestModule.TestPointer;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  TClass = class of TObject;');
-  Add('  TArrInt = array of longint;');
-  Add('var');
-  Add('  v: jsvalue;');
-  Add('  Obj: tobject;');
-  Add('  C: tclass;');
-  Add('  a: tarrint;');
-  Add('  p: Pointer;');
-  Add('begin');
-  Add('  p:=p;');
-  Add('  p:=nil;');
-  Add('  if p=nil then;');
-  Add('  if nil=p then;');
-  Add('  if Assigned(p) then;');
-  Add('  p:=Pointer(v);');
-  Add('  p:=obj;');
-  Add('  p:=c;');
-  Add('  p:=a;');
-  Add('  p:=tobject;');
-  Add('  obj:=TObject(p);');
-  Add('  c:=TClass(p);');
-  Add('  a:=TArrInt(p);');
+  Add(['type',
+  '  TObject = class end;',
+  '  TClass = class of TObject;',
+  '  TArrInt = array of longint;',
+  'const',
+  '  n = nil;',
+  'var',
+  '  v: jsvalue;',
+  '  Obj: tobject;',
+  '  C: tclass;',
+  '  a: tarrint;',
+  '  p: Pointer = nil;',
+  'begin',
+  '  p:=p;',
+  '  p:=nil;',
+  '  if p=nil then;',
+  '  if nil=p then;',
+  '  if Assigned(p) then;',
+  '  p:=Pointer(v);',
+  '  p:=obj;',
+  '  p:=c;',
+  '  p:=a;',
+  '  p:=tobject;',
+  '  obj:=TObject(p);',
+  '  c:=TClass(p);',
+  '  a:=TArrInt(p);',
+  '  p:=n;']);
   ConvertProgram;
   CheckSource('TestPointer',
     LinesToStr([ // statements
@@ -13653,6 +13689,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
+    'this.n = null;',
     'this.v = undefined;',
     'this.Obj = null;',
     'this.C = null;',
@@ -13673,6 +13710,7 @@ begin
     '$mod.Obj = $mod.p;',
     '$mod.C = $mod.p;',
     '$mod.a = $mod.p;',
+    '$mod.p = null;',
     '']));
 end;
 

packages/pastojs/tests/tcprecompile.pas

@@ -39,7 +39,7 @@ type
     procedure CheckPrecompile(MainFile, UnitPaths: string;
       SharedParams: TStringList = nil;
       FirstRunParams: TStringList = nil;
-      SecondRunParams: TStringList = nil);
+      SecondRunParams: TStringList = nil; ExpExitCode: integer = 0);
   public
     constructor Create; override;
     property Format: TPas2JSPrecompileFormat read FFormat write FFormat;
@@ -70,9 +70,9 @@ end;
 
 { TCustomTestCLI_Precompile }
 
-procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile, UnitPaths: string;
-  SharedParams: TStringList; FirstRunParams: TStringList;
-  SecondRunParams: TStringList);
+procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile,
+  UnitPaths: string; SharedParams: TStringList; FirstRunParams: TStringList;
+  SecondRunParams: TStringList; ExpExitCode: integer);
 var
   UnitOutputDir, JSFilename, OrigSrc, NewSrc, s: String;
   JSFile: TCLIFile;
@@ -106,13 +106,16 @@ begin
       Params.Assign(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
-    Compile([MainFile,'-Jc','-FU'+UnitOutputDir]);
-    NewSrc:=JSFile.Source;
-    if not CheckSrcDiff(OrigSrc,NewSrc,s) then
-    begin
-      WriteSources;
-      Fail('test1.js: '+s);
-    end;
+    Compile([MainFile,'-Jc','-FU'+UnitOutputDir],ExpExitCode);
+    if ExpExitCode=0 then
+      begin
+      NewSrc:=JSFile.Source;
+      if not CheckSrcDiff(OrigSrc,NewSrc,s) then
+      begin
+        WriteSources;
+        Fail('test1.js: '+s);
+      end;
+      end;
   finally
     SharedParams.Free;
     FirstRunParams.Free;