diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index d3e30efabe..42ac5425d6 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -363,8 +363,9 @@ unit FPPas2Js; interface uses - Classes, SysUtils, math, contnrs, jsbase, jstree, PasTree, PScanner, - PasResolver, PasResolveEval; + Classes, SysUtils, math, contnrs, + jsbase, jstree, jswriter, + PasTree, PScanner, PasResolveEval, PasResolver; // message numbers const @@ -827,6 +828,8 @@ type TPas2JSProcedureScope = class(TPasProcedureScope) public ResultVarName: string; // valid in implementation ProcScope, empty means use ResolverResultVar + // Option coStoreProcJS + BodyJS: string;// stored in ImplScope end; { TPas2JSWithExprScope } @@ -1167,7 +1170,8 @@ type coEnumNumbers, // use enum numbers instead of names coUseStrict, // insert 'use strict' coNoTypeInfo, // do not generate RTTI - coEliminateDeadCode // skip code that is never executed + coEliminateDeadCode, // skip code that is never executed + coStoreProcJS // store references to JS code in procscopes ); TPasToJsConverterOptions = set of TPasToJsConverterOption; @@ -1255,7 +1259,7 @@ type Procedure DoError(Id: int64; MsgNumber: integer; const MsgPattern: string; Const Args : Array of Const; El: TPasElement); procedure RaiseNotSupported(El: TPasElement; AContext: TConvertContext; Id: int64; const Msg: string = ''); procedure RaiseIdentifierNotFound(Identifier: string; El: TPasElement; Id: int64); - procedure RaiseInconsistency(Id: int64); + procedure RaiseInconsistency(Id: int64; El: TPasElement); // Computation, value conversions Function GetExpressionValueType(El: TPasExpr; AContext: TConvertContext ): TJSType; virtual; Function GetPasIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual; @@ -1355,6 +1359,7 @@ type Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual; Function CreatePropertyGet(Prop: TPasProperty; Ref: TResolvedReference; AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual; + Procedure StorePrecompiledProcedure(ImplProc: TPasProcedure; JS: TJSElement); virtual; // Statements Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; @@ -4086,14 +4091,14 @@ begin //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr Ref.Declaration=',GetObjName(Ref.Declaration)); Proc:=Ref.Declaration as TPasProcedure; if Proc.Name='' then - RaiseInconsistency(20170125191914); + RaiseInconsistency(20170125191914,Proc); //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr Proc.Name=',Proc.Name); ProcScope:=Proc.CustomData as TPasProcedureScope; //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr ProcScope.Element=',GetObjName(ProcScope.Element),' ProcScope.ClassScope=',GetObjName(ProcScope.ClassScope),' ProcScope.DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ProcScope.ImplProc=',GetObjName(ProcScope.ImplProc),' ProcScope.CustomData=',GetObjName(ProcScope.CustomData)); ClassScope:=ProcScope.ClassScope; aClass:=ClassScope.Element; if aClass.Name='' then - RaiseInconsistency(20170125191923); + RaiseInconsistency(20170125191923,aClass); //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr aClass.Name=',aClass.Name); C:=CreateCallExpression(Ref.Element); ok:=false; @@ -4775,7 +4780,7 @@ begin AContext.Access:=caRead; Left:=ConvertElement(El.left,AContext); if Left=nil then - RaiseInconsistency(20170201140821); + RaiseInconsistency(20170201140821,El); AContext.Access:=OldAccess; // convert right side DotContext:=TDotContext.Create(El,Left,AContext); @@ -5103,7 +5108,7 @@ begin RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); end; if Result=nil then - RaiseInconsistency(20170214120048); + RaiseInconsistency(20170214120048,Decl); exit; end; @@ -5182,7 +5187,7 @@ function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; Result:=nil; SelfContext:=AContext.GetSelfContext; if SelfContext=nil then - RaiseInconsistency(20170418114702); + RaiseInconsistency(20170418114702,El); SelfName:=SelfContext.GetLocalName(SelfContext.ThisPas); if Apply and (SelfContext<>AContext) then @@ -5197,11 +5202,11 @@ function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; // -> use the direct ancestor class of the current proc aClass:=SelfContext.ThisPas as TPasClassType; if aClass.CustomData=nil then - RaiseInconsistency(20170323111252); + RaiseInconsistency(20170323111252,aClass); ClassScope:=TPasClassScope(aClass.CustomData); AncestorScope:=ClassScope.AncestorScope; if AncestorScope=nil then - RaiseInconsistency(20170323111306); + RaiseInconsistency(20170323111306,aClass); AncestorClass:=AncestorScope.Element as TPasClassType; FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true) +'.'+TransformVariableName(AncestorProc,AContext); @@ -5409,7 +5414,7 @@ var // s[index] := value AssignContext:=AContext.AccessContext as TAssignContext; if AssignContext.RightSide=nil then - RaiseInconsistency(20180123192020); + RaiseInconsistency(20180123192020,El); AssignSt:=nil; SetStrCall:=nil; @@ -5654,7 +5659,7 @@ var Arg:=nil; inc(ArgNo); if ArgNo>length(El.Params) then - RaiseInconsistency(20170206180553); + RaiseInconsistency(20170206180553,El); end; if ArgNo=length(El.Params) then break; @@ -5712,7 +5717,7 @@ var Result:=true; // bracket accessor of external class if AContext.Resolver.GetPasPropertyArgs(Prop).Count<>1 then - RaiseInconsistency(20170403003753); + RaiseInconsistency(20170403003753,Prop); // bracket accessor of external class -> create PathEl[param] Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El.Params[0])); try @@ -5822,7 +5827,7 @@ var {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertArrayParams.ConvertIndexedProperty missing default value: Prop=',Prop.Name,' i=',i); {$ENDIF} - RaiseInconsistency(20170206185126); + RaiseInconsistency(20170206185126,TargetArg); end; AContext.Access:=caRead; Arg:=ConvertElement(TargetArg.ValueExpr,ArgContext); @@ -5932,7 +5937,7 @@ Var aClass: TPasClassType; begin if El.Kind<>pekArrayParams then - RaiseInconsistency(20170209113713); + RaiseInconsistency(20170209113713,El); ArgContext:=AContext; while ArgContext is TDotContext do ArgContext:=ArgContext.Parent; @@ -5984,7 +5989,7 @@ begin // anObject[] ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty) else - RaiseInconsistency(20170206180448); + RaiseInconsistency(20170206180448,aClass); end else if TypeEl.ClassType=TPasClassOfType then begin @@ -5992,7 +5997,7 @@ begin DestType:=AContext.Resolver.ResolveAliasType(TPasClassOfType(TypeEl).DestType); ClassScope:=DestType.CustomData as TPas2JSClassScope; if ClassScope.DefaultProperty=nil then - RaiseInconsistency(20170206180503); + RaiseInconsistency(20170206180503,DestType); ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty); end else if TypeEl.ClassType=TPasArrayType then @@ -6025,7 +6030,7 @@ var begin Result:=nil; if El.Kind<>pekFuncParams then - RaiseInconsistency(20170209113515); + RaiseInconsistency(20170209113515,El); //writeln('TPasToJSConverter.ConvertFuncParams START pekFuncParams ',GetObjName(El.CustomData),' ',GetObjName(El.Value.CustomData)); Call:=nil; Elements:=nil; @@ -6078,7 +6083,7 @@ begin RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); end; if Result=nil then - RaiseInconsistency(20170210121932); + RaiseInconsistency(20170210121932,El); exit; end else if Decl.CustomData is TResElDataBaseType then @@ -6318,7 +6323,7 @@ begin NewExpr:=nil; end else - RaiseInconsistency(20170323083214); + RaiseInconsistency(20170323083214,Proc); finally ExtNameEl.Free; NewExpr.Free; @@ -6367,7 +6372,7 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertTObjectFree With=',GetObjName(WithExprScope.Expr)); {$ENDIF} - RaiseInconsistency(20170517092248); + RaiseInconsistency(20170517092248,Bin); end; LeftJS:=ConvertElement(Bin.left,AContext); @@ -6379,7 +6384,7 @@ begin begin aName:=TJSPrimaryExpressionIdent(LeftJS).Name; if Pos('.',aName)>0 then - RaiseInconsistency(20170516173832); + RaiseInconsistency(20170516173832,Bin.left); // v.free // -> v=rtl.freeLoc(v); Getter:=LeftJS; @@ -6704,7 +6709,7 @@ var ArgEl: TPasExpr; begin if El.Kind<>pekSet then - RaiseInconsistency(20170209112737); + RaiseInconsistency(20170209112737,El); if AContext.Access<>caRead then DoError(20170209112926,nCantWriteSetLiteral,sCantWriteSetLiteral,[],El); if length(El.Params)=0 then @@ -6840,7 +6845,7 @@ begin Result:=nil; Param0:=El.Params[0]; if AContext.Access<>caRead then - RaiseInconsistency(20170213213621); + RaiseInconsistency(20170213213621,El); AContext.Resolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]); {$IFDEF VerbosePasResolver} writeln('TPasToJSConverter.ConvertBuiltInSetLength ',GetResolverResultDbg(ResolvedParam0)); @@ -7107,7 +7112,7 @@ var begin Result:=nil; if AContext.Resolver=nil then - RaiseInconsistency(20170210105235); + RaiseInconsistency(20170210105235,El); Param:=El.Params[0]; AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]); {$IFDEF VerbosePas2JS} @@ -7164,7 +7169,7 @@ var begin Result:=nil; if AContext.Resolver=nil then - RaiseInconsistency(20170325185847); + RaiseInconsistency(20170325185847,El); Param:=El.Params[0]; AContext.Resolver.ComputeElement(Param,ParamResolved,[]); if ParamResolved.BaseType in btAllJSInteger then @@ -7192,7 +7197,7 @@ var begin Result:=nil; if AContext.Resolver=nil then - RaiseInconsistency(20170210105235); + RaiseInconsistency(20170210105235,El); Param:=El.Params[0]; AContext.Resolver.ComputeElement(Param,ParamResolved,[]); if ParamResolved.BaseType=btChar then @@ -7218,7 +7223,7 @@ begin Minus:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param)); Call.AddArg(Minus); if length(SubParams.Params)<>1 then - RaiseInconsistency(20170405231706); + RaiseInconsistency(20170405231706,El); Minus.A:=ConvertElement(SubParams.Params[0],AContext); Minus.B:=CreateLiteralNumber(Param,1); Result:=Call; @@ -7295,7 +7300,7 @@ var begin Result:=nil; if AContext.Resolver=nil then - RaiseInconsistency(20170210120659); + RaiseInconsistency(20170210120659,El); Param:=El.Params[0]; AContext.Resolver.ComputeElement(Param,ResolvedEl,[]); case ResolvedEl.BaseType of @@ -7456,7 +7461,7 @@ var begin Result:=nil; if AContext.Resolver=nil then - RaiseInconsistency(20170210120648); + RaiseInconsistency(20170210120648,El); Param:=El.Params[0]; AContext.Resolver.ComputeElement(Param,ResolvedEl,[]); if (ResolvedEl.BaseType in btAllJSInteger) @@ -7655,7 +7660,7 @@ var i: Integer; begin if length(El.Params)<1 then - RaiseInconsistency(20170331000332); + RaiseInconsistency(20170331000332,El); if length(El.Params)=1 then begin // concat(array1) -> array1 @@ -7727,9 +7732,9 @@ begin Param:=El.Params[0]; AContext.Resolver.ComputeElement(El,ParamResolved,[]); if ParamResolved.BaseType<>btContext then - RaiseInconsistency(20170401003242); + RaiseInconsistency(20170401003242,El); if ParamResolved.TypeEl.ClassType<>TPasArrayType then - RaiseInconsistency(20170401003256); + RaiseInconsistency(20170401003256,El); ArrayType:=TPasArrayType(ParamResolved.TypeEl); AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]); // rtl.arrayCopy(type,src,start,count) @@ -8014,7 +8019,7 @@ var Ident: TJSPrimaryExpressionIdent; begin if AName='' then - RaiseInconsistency(20170402230134); + RaiseInconsistency(20170402230134,Src); p:=PosLast('.',AName); if p>0 then begin @@ -8764,7 +8769,7 @@ begin // module.$rtti.$Class("classname"); Result:=CreateRTTINewType(aClass,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit); if ObjLit<>nil then - RaiseInconsistency(20170412093427); + RaiseInconsistency(20170412093427,El); end; function TPasToJSConverter.ConvertClassExternalType(El: TPasClassType; @@ -8846,7 +8851,7 @@ begin // prepend module.$rtti.$Class("classname"); Call:=CreateRTTINewType(DestType,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit); if ObjLit<>nil then - RaiseInconsistency(20170412102654); + RaiseInconsistency(20170412102654,El); List:=TJSStatementList(CreateElement(TJSStatementList,El)); List.A:=Call; List.B:=Result; @@ -9488,7 +9493,7 @@ Var n, i:Integer; AssignSt: TJSSimpleAssignStatement; FuncContext: TFunctionContext; - ProcScope, ImplProcScope: TPasProcedureScope; + ProcScope, ImplProcScope: TPas2JSProcedureScope; Arg: TPasArgument; SelfSt: TJSVariableStatement; ImplProc: TPasProcedure; @@ -9504,7 +9509,7 @@ begin if El.IsAbstract then exit; if El.IsExternal then exit; - ProcScope:=TPasProcedureScope(El.CustomData); + ProcScope:=TPas2JSProcedureScope(El.CustomData); if ProcScope.DeclarationProc<>nil then exit; @@ -9515,7 +9520,7 @@ begin ImplProc:=El; if ProcScope.ImplProc<>nil then ImplProc:=ProcScope.ImplProc; - ImplProcScope:=TPasProcedureScope(ImplProc.CustomData); + ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData); AssignSt:=nil; if AContext.IsGlobal then @@ -9535,6 +9540,7 @@ begin Result:=FS; FD.Name:=TJSString(TransformVariableName(El,AContext)); end; + for n := 0 to El.ProcType.Args.Count - 1 do begin Arg:=TPasArgument(El.ProcType.Args[n]); @@ -9625,6 +9631,9 @@ begin FuncContext.Free; end; end; + + if coStoreProcJS in Options then + StorePrecompiledProcedure(ImplProc,Result); end; function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock; @@ -10062,7 +10071,7 @@ begin // create implementation declarations ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext); if ImplDecl<>nil then - RaiseInconsistency(20170910175032); // elements should have been added directly + RaiseInconsistency(20170910175032,El); // elements should have been added directly if Src.Statements[Src.Statements.Count-1].Node=ImplVarSt then exit; // no implementation // add impl declarations @@ -10095,9 +10104,9 @@ var begin Result:=nil; if Left=nil then - RaiseInconsistency(20170201140827); + RaiseInconsistency(20170201140827,aParent); if Right=nil then - RaiseInconsistency(20170211192018); + RaiseInconsistency(20170211192018,aParent); ok:=false; try // create a TJSDotMemberExpression of Left and the left-most identifier of Right @@ -10160,7 +10169,7 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.CreateDotExpression Right=',GetObjName(Right),' RightParent=',GetObjName(RightParent),' Result=',GetObjName(Result)); {$ENDIF} - RaiseInconsistency(20170129141307); + RaiseInconsistency(20170129141307,aParent); end; Dot.MExpr := Left; Dot.Name := TJSPrimaryExpressionIdent(Right).Name; @@ -10261,7 +10270,7 @@ var begin Result:=nil; if not (ResolvedEl.IdentEl is TPasProcedure) then - RaiseInconsistency(20170215140756); + RaiseInconsistency(20170215140756,El); Target:=ConvertElement(El,AContext); @@ -10370,7 +10379,7 @@ begin if AssignContext.RightSide<>nil then begin LHS.Free; - RaiseInconsistency(20170207215447); + RaiseInconsistency(20170207215447,LeftEl); end; Result:=LHS; end @@ -10502,7 +10511,7 @@ begin // get module path aModule:=El.GetModule; if aModule=nil then - RaiseInconsistency(20170418115552); + RaiseInconsistency(20170418115552,El); RttiPath:=AContext.GetLocalName(aModule); if RttiPath='' then RttiPath:=TransformModuleName(aContext.GetRootModule,true,AContext); @@ -10730,7 +10739,7 @@ begin try // stored if StoredValue.Kind<>revkBool then - RaiseInconsistency(20170924082845); + RaiseInconsistency(20170924082845,Prop); StoredExpr:=nil; if TResEvalBool(StoredValue).B then inc(Flags,pfStoredTrue) @@ -11016,6 +11025,29 @@ begin end; end; +procedure TPasToJSConverter.StorePrecompiledProcedure(ImplProc: TPasProcedure; + JS: TJSElement); +var + ImplScope: TPas2JSProcedureScope; + aWriter: TBufferWriter; + aJSWriter: TJSWriter; +begin + ImplScope:=TPas2JSProcedureScope(ImplProc.CustomData); + if ImplScope.ImplProc<>nil then + RaiseInconsistency(20180228124545,ImplProc); + aJSWriter:=nil; + aWriter:=TBufferWriter.Create(1000); + try + aJSWriter:=TJSWriter.Create(aWriter); + aJSWriter.IndentSize:=2; + aJSWriter.WriteJS(JS); + ImplScope.BodyJS:=aWriter.AsAnsistring; + finally + aJSWriter.Free; + aWriter.Free; + end; +end; + function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext): TJSElement; @@ -11232,7 +11264,7 @@ begin begin // left side is a Setter -> RightSide was already inserted as parameter if AssignContext.RightSide<>nil then - RaiseInconsistency(20170207215544); + RaiseInconsistency(20170207215544,El.left); Result:=LHS; end else @@ -11719,7 +11751,7 @@ Var begin Result:=Nil; if AContext.Access<>caRead then - RaiseInconsistency(20170213213740); + RaiseInconsistency(20170213213740,El); ForScope:=El.CustomData as TPasForLoopScope; // can be nil! case El.LoopType of ltNormal,ltDown: ; @@ -12054,7 +12086,7 @@ begin // $with1.X = 3; FuncContext:=TFunctionContext(AContext.GetContextOfType(TFunctionContext)); if FuncContext=nil then - RaiseInconsistency(20170212003759); + RaiseInconsistency(20170212003759,El); FirstSt:=nil; LastSt:=nil; try @@ -12167,7 +12199,7 @@ begin Result:=false; if aClass.Parent=nil then exit; if not aClass.Parent.InheritsFrom(TPasDeclarations) then - RaiseInconsistency(20170412101457); + RaiseInconsistency(20170412101457,aClass); Decls:=TPasDeclarations(aClass.Parent); Types:=Decls.Types; for i:=0 to Types.Count-1 do @@ -12190,11 +12222,6 @@ begin end; end; -procedure TPasToJSConverter.RaiseInconsistency(Id: int64); -begin - raise Exception.Create('TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug'); -end; - function TPasToJSConverter.CreateUnary(Members: array of string; E: TJSElement): TJSUnary; var unary: TJSUnary; @@ -12384,7 +12411,7 @@ begin begin if AContext.Resolver=nil then exit(CreateLiteralUndefined(El)); - RaiseInconsistency(20170415185745); + RaiseInconsistency(20170415185745,El); end; Result:=ConvertElement(Expr,AContext); if Result=nil then @@ -12662,7 +12689,7 @@ var JS: TJSString; begin if Lit.Value.ValueType<>jstString then - RaiseInconsistency(20171112020856); + RaiseInconsistency(20171112020856,ErrorEl); if Lit.Value.CustomValue<>'' then JS:=Lit.Value.CustomValue else @@ -12814,7 +12841,7 @@ var BinExpr: TJSBinaryExpression; begin if not (OpCode in [eopEqual,eopNotEqual]) then - RaiseInconsistency(20170401184819); + RaiseInconsistency(20170401184819,El); Call:=CreateCallExpression(El); Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]); Call.AddArg(JSArray); @@ -13018,7 +13045,7 @@ begin // in other unit -> use pas.unitname.$impl FoundModule:=El.GetModule; if FoundModule=nil then - RaiseInconsistency(20161024192755); + RaiseInconsistency(20161024192755,El); Prepend(Result,TransformModuleName(FoundModule,true,AContext) +'.'+FBuiltInNames[pbivnImplementation]); end; @@ -13334,7 +13361,7 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter)); {$ENDIF} - RaiseInconsistency(20170213222941); + RaiseInconsistency(20170213222941,El); end; // create "{p:Result,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}" @@ -13344,7 +13371,7 @@ begin begin // create "{get:function(){return FullGetter;},set:function(v){FullGetter=v;}}" if (ParamContext.Getter<>nil) and (ParamContext.Getter<>FullGetter) then - RaiseInconsistency(20170213224339); + RaiseInconsistency(20170213224339,El); GetPath:=String(TJSPrimaryExpressionIdent(FullGetter).Name); GetDotPos:=PosLast('.',GetPath); if GetDotPos>0 then @@ -13471,7 +13498,7 @@ begin else if (SetExpr.ClassType=TJSCallExpression) then // has already the form Func(v) else - RaiseInconsistency(20170213225940); + RaiseInconsistency(20170213225940,El); // add p:GetPathExpr AddVar(GetPathName,GetPathExpr); @@ -13717,7 +13744,7 @@ begin if El=nil then begin Result:=nil; - RaiseInconsistency(20161024190203); + RaiseInconsistency(20161024190203,El); end; C:=El.ClassType; if (C=TPasConst) then @@ -14067,7 +14094,7 @@ begin // module.$rtti.$Record("typename",{}); Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewRecord],false,AContext,ObjLit); if ObjLit=nil then - RaiseInconsistency(20170412124804); + RaiseInconsistency(20170412124804,El); if El.Members.Count>0 then begin // module.$rtti.$Record("typename",{}).addFields( @@ -14168,6 +14195,23 @@ begin raise E; end; +procedure TPasToJSConverter.RaiseInconsistency(Id: int64; El: TPasElement); +var + s: String; +begin + s:='TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug'; + if El<>nil then + begin + s:=s+El.FullName; + if El.Name<>'' then + s:=s+El.Name + else + s:=s+GetElementTypeName(El); + s:=s+' at '+TPas2JSResolver.GetDbgSourcePosStr(El); + end; + raise Exception.Create(s); +end; + function TPasToJSConverter.TransformVariableName(El: TPasElement; const AName: String; AContext: TConvertContext): String; var @@ -14176,7 +14220,7 @@ var begin if AContext=nil then ; if Pos('.',AName)>0 then - RaiseInconsistency(20170203164711); + RaiseInconsistency(20170203164711,El); if UseLowerCase then Result:=LowerCase(AName) else @@ -14299,7 +14343,7 @@ begin Result:=''; El:=AContext.Resolver.ResolveAliasType(El); if El=nil then - RaiseInconsistency(20170409172756); + RaiseInconsistency(20170409172756,El); if El=AContext.PasElement then begin // referring to itself diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index 6888401bd0..4d0f38effe 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -26,15 +26,16 @@ Works: - resolving forward references - restore resolver scopes - restore resolved references and access flags +- write+read compiled proc body ToDo: -- test restoring types -- test restoring expressions -- interface/implementation references - store converted proc implementation - store references + - code - local const +- store only used elements, not unneeded privates - use stored converted proc implementation +- WPO uses Proc.References - store converted initialization/finalization - use stored converted initialization/finalization - uses section @@ -52,7 +53,7 @@ interface uses Classes, Types, SysUtils, contnrs, AVL_Tree, crc, fpjson, jsonparser, jsonscanner, - PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer, + PasTree, PScanner, PParser, PasResolveEval, PasResolver, Pas2jsFileUtils, FPPas2Js; const @@ -183,14 +184,15 @@ const 'ObjectChecks' ); - PJUDefaultConvertOptions: TPasToJsConverterOptions = []; + PJUDefaultConvertOptions: TPasToJsConverterOptions = [coStoreProcJS]; PJUConverterOptions: array[TPasToJsConverterOption] of string = ( 'LowerCase', 'SwitchStatement', 'EnumNumbers', 'UseStrict', 'NoTypeInfo', - 'EliminateDeadCode' + 'EliminateDeadCode', + 'StoreProcJS' ); PJUDefaultTargetPlatform = PlatformBrowser; @@ -590,7 +592,7 @@ type TPJUWriter = class(TPJUFiler) private - FAnalyzer: TPasAnalyzer; + FConverter: TPasToJSConverter; FElementIdCounter: integer; FSourceFilesSorted: TPJUSourceFileArray; FInImplementation: boolean; @@ -686,13 +688,12 @@ type constructor Create; override; destructor Destroy; override; procedure Clear; override; - procedure WritePJU(aResolver: TPas2JSResolver; + procedure WritePJU(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter; InitFlags: TPJUInitialFlags; aStream: TStream; Compressed: boolean); virtual; - function WriteJSON(aResolver: TPas2JSResolver; + function WriteJSON(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter; InitFlags: TPJUInitialFlags): TJSONObject; virtual; function IndexOfSourceFile(const Filename: string): integer; property SourceFilesSorted: TPJUSourceFileArray read FSourceFilesSorted; - property Analyzer: TPasAnalyzer read FAnalyzer; end; { TPJUReaderContext } @@ -859,6 +860,7 @@ type const PropName: string; const DefaultValue: TPasProcedureScopeFlags): TPasProcedureScopeFlags; virtual; procedure ReadProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPJUReaderContext); virtual; procedure ReadProcScopeReferences(Obj: TJSONObject; ImplScope: TPas2JSProcedureScope); virtual; + procedure ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; aContext: TPJUReaderContext); virtual; procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPJUReaderContext); virtual; procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPJUReaderContext); virtual; // ToDo: procedure ReadExternalReferences(ParentJSON: TJSONObject); virtual; @@ -2857,13 +2859,13 @@ procedure TPJUWriter.WriteProcedure(Obj: TJSONObject; El: TPasProcedure; var DefProcMods: TProcedureModifiers; Scope: TPas2JSProcedureScope; - List: TFPList; + Refs: TFPList; Arr: TJSONArray; i: Integer; PSRef: TPasProcScopeReference; SubObj: TJSONObject; DeclProc: TPasProcedure; - DeclScope: TPasProcedureScope; + DeclScope: TPas2JsProcedureScope; Ref: TPJUFilerElementRef; begin WritePasElement(Obj,El,aContext); @@ -2896,40 +2898,49 @@ begin if (Scope.ImplProc=nil) and (El.Body<>nil) then begin - // Note: the References are stored in the declaration scope, - // but in the JSON of the implementation scope, so that + // Note: although the References are in the declaration scope, + // they are stored with the implementation scope, so that // all references can be resolved immediately by the reader DeclProc:=Scope.DeclarationProc; if DeclProc=nil then DeclProc:=El; - DeclScope:=NoNil(DeclProc.CustomData) as TPasProcedureScope; + DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope; // write references - if DeclScope.References=nil then - Analyzer.AnalyzeProcRefs(DeclProc); - List:=DeclScope.GetReferences; - try - if List.Count>0 then - begin - Arr:=TJSONArray.Create; - Obj.Add('ProcRefs',Arr); - for i:=0 to List.Count-1 do + if DeclScope.References<>nil then + begin + Refs:=DeclScope.GetReferences; + try + if Refs.Count>0 then begin - PSRef:=TPasProcScopeReference(List[i]); - Ref:=GetElementReference(PSRef.Element); - if (Ref.Id=0) and not (Ref.Element is TPasUnresolvedSymbolRef) then - RaiseMsg(20180221170307,El,GetObjName(Ref.Element)); - SubObj:=TJSONObject.Create; - Arr.Add(SubObj); - if PSRef.Access<>PJUDefaultPSRefAccess then - SubObj.Add('Access',PJUPSRefAccessNames[PSRef.Access]); - AddReferenceToObj(SubObj,'Id',PSRef.Element); + Arr:=TJSONArray.Create; + Obj.Add('ProcRefs',Arr); + for i:=0 to Refs.Count-1 do + begin + PSRef:=TPasProcScopeReference(Refs[i]); + Ref:=GetElementReference(PSRef.Element); + if (Ref.Id=0) and not (Ref.Element is TPasUnresolvedSymbolRef) then + RaiseMsg(20180221170307,El,GetObjName(Ref.Element)); + SubObj:=TJSONObject.Create; + Arr.Add(SubObj); + if PSRef.Access<>PJUDefaultPSRefAccess then + SubObj.Add('Access',PJUPSRefAccessNames[PSRef.Access]); + AddReferenceToObj(SubObj,'Id',PSRef.Element); + end; end; - end; - finally - Analyzer.Clear; - List.Free; - end; + finally + Refs.Free; + end; + end; + + // precompiled body + if Scope.BodyJS<>'' then + begin + Obj.Add('Body',Scope.BodyJS); + // ToDo: globals + end; end; + if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then + RaiseMsg(20180228142831,El); end; procedure TPJUWriter.WriteOperator(Obj: TJSONObject; El: TPasOperator; @@ -3006,12 +3017,10 @@ end; constructor TPJUWriter.Create; begin inherited Create; - FAnalyzer:=TPasAnalyzer.Create; end; destructor TPJUWriter.Destroy; begin - FreeAndNil(FAnalyzer); inherited Destroy; end; @@ -3025,7 +3034,8 @@ begin end; procedure TPJUWriter.WritePJU(aResolver: TPas2JSResolver; - InitFlags: TPJUInitialFlags; aStream: TStream; Compressed: boolean); + aConverter: TPasToJSConverter; InitFlags: TPJUInitialFlags; aStream: TStream; + Compressed: boolean); var CurIndent: integer; Spaces: string; @@ -3157,7 +3167,7 @@ var aJSON: TJSONObject; begin CurIndent:=0; - aJSON:=WriteJSON(aResolver,InitFlags); + aJSON:=WriteJSON(aResolver,aConverter,InitFlags); try WriteObj(aJSON); finally @@ -3166,12 +3176,13 @@ begin end; function TPJUWriter.WriteJSON(aResolver: TPas2JSResolver; - InitFlags: TPJUInitialFlags): TJSONObject; + aConverter: TPasToJSConverter; InitFlags: TPJUInitialFlags): TJSONObject; var Obj, JSMod: TJSONObject; aContext: TPJUWriterContext; begin Result:=nil; + FConverter:=aConverter; FResolver:=aResolver; FParser:=Resolver.CurrentParser; FScanner:=FParser.Scanner; @@ -3180,8 +3191,6 @@ begin aContext:=nil; Obj:=TJSONObject.Create; try - Analyzer.Clear; - Analyzer.Resolver:=aResolver; WriteHeaderMagic(Obj); WriteHeaderVersion(Obj); WriteInitialFlags(Obj); @@ -3200,7 +3209,6 @@ begin aContext.Free; if Result=nil then Obj.Free; - Analyzer.Clear; end; end; @@ -5781,6 +5789,19 @@ begin end; end; +procedure TPJUReader.ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; + aContext: TPJUReaderContext); +var + ImplScope: TPas2JSProcedureScope; + s: string; +begin + ImplScope:=TPas2JSProcedureScope(El.CustomData); + if not ReadString(Obj,'Body',s,El) then + RaiseMsg(20180228131232,El); + ImplScope.BodyJS:=s; + if aContext=nil then ; +end; + procedure TPJUReader.ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPJUReaderContext); var @@ -5848,7 +5869,9 @@ begin if Obj.Find('ImplProc')=nil then ReadProcScopeReferences(Obj,Scope); - // ToDo: Body : TProcedureBody; + + if Obj.Find('Body')<>nil then + ReadProcedureBody(Obj,El,aContext); end; procedure TPJUReader.ReadOperator(Obj: TJSONObject; El: TPasOperator; diff --git a/packages/pastojs/tests/tcfiler.pas b/packages/pastojs/tests/tcfiler.pas index 72d6120a25..60d1ac9ae1 100644 --- a/packages/pastojs/tests/tcfiler.pas +++ b/packages/pastojs/tests/tcfiler.pas @@ -40,10 +40,13 @@ type FPJUWriter: TPJUWriter; procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer); + function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean; + function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean; protected procedure SetUp; override; procedure TearDown; override; - procedure ConvertModule; override; + function CreateConverter: TPasToJSConverter; override; + procedure ParseUnit; override; procedure WriteReadUnit; virtual; procedure StartParsing; override; function CheckRestoredObject(const Path: string; Orig, Rest: TObject): boolean; virtual; @@ -164,12 +167,27 @@ begin end; end; +function TCustomTestPrecompile.OnConverterIsElementUsed(Sender: TObject; + El: TPasElement): boolean; +begin + Result:=Analyzer.IsUsed(El); +end; + +function TCustomTestPrecompile.OnConverterIsTypeInfoUsed(Sender: TObject; + El: TPasElement): boolean; +begin + Result:=Analyzer.IsTypeInfoUsed(El); +end; + procedure TCustomTestPrecompile.SetUp; begin inherited SetUp; FInitialFlags:=TPJUInitialFlags.Create; FAnalyzer:=TPasAnalyzer.Create; Analyzer.Resolver:=Engine; + Analyzer.Options:=Analyzer.Options+[paoProcImplReferences]; + Converter.OnIsElementUsed:=@OnConverterIsElementUsed; + Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed; end; procedure TCustomTestPrecompile.TearDown; @@ -181,10 +199,16 @@ begin inherited TearDown; end; -procedure TCustomTestPrecompile.ConvertModule; +function TCustomTestPrecompile.CreateConverter: TPasToJSConverter; begin + Result:=inherited CreateConverter; + Result.Options:=Result.Options+[coStoreProcJS]; +end; + +procedure TCustomTestPrecompile.ParseUnit; +begin + inherited ParseUnit; Analyzer.AnalyzeModule(Module); - inherited ConvertModule; end; procedure TCustomTestPrecompile.WriteReadUnit; @@ -208,7 +232,7 @@ begin try try PJUWriter.OnGetSrc:=@OnFilerGetSrc; - PJUWriter.WritePJU(Engine,InitialFlags,ms,false); + PJUWriter.WritePJU(Engine,Converter,InitialFlags,ms,false); except on E: Exception do begin @@ -484,10 +508,35 @@ end; procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); +var + OrigList, RestList: TStringList; + i: Integer; begin CheckRestoredReference(Path+'.DeclarationProc',Orig.DeclarationProc,Rest.DeclarationProc); CheckRestoredReference(Path+'.ImplProc',Orig.ImplProc,Rest.ImplProc); CheckRestoredProcScopeRefs(Path+'.References',Orig,Rest); + if Orig.BodyJS<>Rest.BodyJS then + begin + writeln('TCustomTestPrecompile.CheckRestoredProcScope ',Path,'.BodyJS diff:'); + OrigList:=TStringList.Create; + RestList:=TStringList.Create; + try + OrigList.Text:=Orig.BodyJS; + RestList.Text:=Rest.BodyJS; + for i:=0 to OrigList.Count-1 do + begin + if i>=RestList.Count then + Fail(Path+'.BodyJS RestLine missing: '+OrigList[i]); + writeln(' ',i,': '+OrigList[i]); + end; + if OrigList.CountMinP) and not (p[-1] in [#10,#13]) do dec(p); + Result:=p; + end; + + procedure DiffFound; + var + ActLineStartP, ActLineEndP, p, StartPos: PChar; + ExpLine, ActLine: String; + i: Integer; + begin + writeln('Diff found "',Msg,'". Lines:'); + // write correct lines + p:=PChar(Expected); + repeat + StartPos:=p; + while not (p^ in [#0,#10,#13]) do inc(p); + ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos); + if p^ in [#10,#13] then + begin + if (p[1] in [#10,#13]) and (p^<>p[1]) then + inc(p,2) + else + inc(p); + end; + if (p<=ExpectedP) and (p^<>#0) then + begin + writeln('= ',ExpLine); + end else begin + // diff line + // write actual line + ActLineStartP:=FindLineStart(ActualP,PChar(Actual)); + ActLineEndP:=FindLineEnd(ActualP); + ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP); + writeln('- ',ActLine); + // write expected line + writeln('+ ',ExpLine); + // write empty line with pointer ^ + for i:=1 to 2+ExpectedP-StartPos do write(' '); + writeln('^'); + Msg:='expected "'+ExpLine+'", but got "'+ActLine+'".'; + CheckSrcDiff:=false; + exit; + end; + until p^=#0; + + writeln('DiffFound Actual:-----------------------'); + writeln(Actual); + writeln('DiffFound Expected:---------------------'); + writeln(Expected); + writeln('DiffFound ------------------------------'); + Msg:='diff found, but lines are the same, internal error'; + CheckSrcDiff:=false; + end; + +var + IsSpaceNeeded: Boolean; + LastChar, Quote: Char; +begin + Result:=true; + Msg:=''; + if Expected='' then Expected:=' '; + if Actual='' then Actual:=' '; + ExpectedP:=PChar(Expected); + ActualP:=PChar(Actual); + repeat + //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"'); + case ExpectedP^ of + #0: + begin + // check that rest of Actual has only spaces + while ActualP^ in SpaceChars do inc(ActualP); + if ActualP^<>#0 then + begin + DiffFound; + exit; + end; + exit(true); + end; + ' ',#9,#10,#13: + begin + // skip space in Expected + IsSpaceNeeded:=false; + if ExpectedP>PChar(Expected) then + LastChar:=ExpectedP[-1] + else + LastChar:=#0; + while ExpectedP^ in SpaceChars do inc(ExpectedP); + if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$']) + and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then + IsSpaceNeeded:=true; + if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then + begin + DiffFound; + exit; + end; + while ActualP^ in SpaceChars do inc(ActualP); + end; + '''','"': + begin + while ActualP^ in SpaceChars do inc(ActualP); + if ExpectedP^<>ActualP^ then + begin + DiffFound; + exit; + end; + Quote:=ExpectedP^; + repeat + inc(ExpectedP); + inc(ActualP); + if ExpectedP^<>ActualP^ then + begin + DiffFound; + exit; + end; + if (ExpectedP^ in [#0,#10,#13]) then + break + else if (ExpectedP^=Quote) then + begin + inc(ExpectedP); + inc(ActualP); + break; + end; + until false; + end; + else + while ActualP^ in SpaceChars do inc(ActualP); + if ExpectedP^<>ActualP^ then + begin + DiffFound; + exit; + end; + inc(ExpectedP); + inc(ActualP); + end; + until false; +end; + { TTestEnginePasResolver } procedure TTestEnginePasResolver.SetModule(AValue: TPasModule); @@ -1217,114 +1370,11 @@ end; procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string); // search diff, ignore changes in spaces -const - SpaceChars = [#9,#10,#13,' ']; var - ExpectedP, ActualP: PChar; - - function FindLineEnd(p: PChar): PChar; - begin - Result:=p; - while not (Result^ in [#0,#10,#13]) do inc(Result); - end; - - function FindLineStart(p, MinP: PChar): PChar; - begin - while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p); - Result:=p; - end; - - procedure DiffFound; - var - ActLineStartP, ActLineEndP, p, StartPos: PChar; - ExpLine, ActLine: String; - i: Integer; - begin - writeln('Diff found "',Msg,'". Lines:'); - // write correct lines - p:=PChar(Expected); - repeat - StartPos:=p; - while not (p^ in [#0,#10,#13]) do inc(p); - ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos); - if p^ in [#10,#13] then - begin - if (p[1] in [#10,#13]) and (p^<>p[1]) then - inc(p,2) - else - inc(p); - end; - if (p<=ExpectedP) and (p^<>#0) then - begin - writeln('= ',ExpLine); - end else begin - // diff line - // write actual line - ActLineStartP:=FindLineStart(ActualP,PChar(Actual)); - ActLineEndP:=FindLineEnd(ActualP); - ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP); - writeln('- ',ActLine); - // write expected line - writeln('+ ',ExpLine); - // write empty line with pointer ^ - for i:=1 to 2+ExpectedP-StartPos do write(' '); - writeln('^'); - AssertEquals(Msg,ExpLine,ActLine); - break; - end; - until p^=#0; - - writeln('DiffFound Actual:-----------------------'); - writeln(Actual); - writeln('DiffFound Expected:---------------------'); - writeln(Expected); - writeln('DiffFound ------------------------------'); - Fail('diff found, but lines are the same, internal error'); - end; - -var - IsSpaceNeeded: Boolean; - LastChar: Char; + s: string; begin - if Expected='' then Expected:=' '; - if Actual='' then Actual:=' '; - ExpectedP:=PChar(Expected); - ActualP:=PChar(Actual); - repeat - //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"'); - case ExpectedP^ of - #0: - begin - // check that rest of Actual has only spaces - while ActualP^ in SpaceChars do inc(ActualP); - if ActualP^<>#0 then - DiffFound; - exit; - end; - ' ',#9,#10,#13: - begin - // skip space in Expected - IsSpaceNeeded:=false; - if ExpectedP>PChar(Expected) then - LastChar:=ExpectedP[-1] - else - LastChar:=#0; - while ExpectedP^ in SpaceChars do inc(ExpectedP); - if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$']) - and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then - IsSpaceNeeded:=true; - if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then - DiffFound; - while ActualP^ in SpaceChars do inc(ActualP); - end; - else - while ActualP^ in SpaceChars do inc(ActualP); - if ExpectedP^<>ActualP^ then - DiffFound; - inc(ExpectedP); - inc(ActualP); - end; - until false; + if CheckSrcDiff(Expected,Actual,s) then exit; + Fail(Msg+': '+s); end; procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string); @@ -5515,7 +5565,6 @@ begin Add(' end;'); Add('end;'); ConvertUnit; - // ToDo: check use analyzer CheckSource('TestAsmPas_Impl', LinesToStr([ 'var $impl = $mod.$impl;',