From afb706b772d27e7107a8111363194e9f2a906bd7 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 18 Mar 2018 13:00:59 +0000 Subject: [PATCH] pastojs: writer: external reference queue git-svn-id: trunk@38564 - --- packages/fcl-passrc/src/pasresolver.pp | 1 + packages/pastojs/src/fppas2js.pp | 6 +- packages/pastojs/src/pas2jscompiler.pp | 17 +++++ packages/pastojs/src/pas2jsfiler.pp | 85 ++++++++++++++++++------ packages/pastojs/src/pas2jslogger.pp | 1 + packages/pastojs/tests/tcmodules.pas | 86 ++++++++++++++++++------- packages/pastojs/tests/tcprecompile.pas | 25 +++---- 7 files changed, 164 insertions(+), 57 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index a88fc234b7..10cab5cef2 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/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 diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 3e1b57e2da..45144f9023 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/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) diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 3830556428..75facfd7e7 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/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); diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index a93d743153..7923e2fe43 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/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; diff --git a/packages/pastojs/src/pas2jslogger.pp b/packages/pastojs/src/pas2jslogger.pp index e283999c5a..581e89b958 100644 --- a/packages/pastojs/src/pas2jslogger.pp +++ b/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 diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 168bf6bf32..3f9273b66c 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/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; diff --git a/packages/pastojs/tests/tcprecompile.pas b/packages/pastojs/tests/tcprecompile.pas index 6bdbb9efec..1a924a4f1c 100644 --- a/packages/pastojs/tests/tcprecompile.pas +++ b/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;