From d6d10a522adbea893da136c1da13ac9b6c50a5b8 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 4 Dec 2016 09:35:53 +0000 Subject: [PATCH] * Patch from Mattias Gaertner - more tests - case-of: added option to change between switch and if-else - Some changes to the way the implementation block is generated for units. git-svn-id: trunk@35055 - --- packages/fcl-js/src/jstree.pp | 2 +- packages/fcl-js/src/jswriter.pp | 59 +-- packages/pastojs/src/fppas2js.pp | 633 +++++++++++++++++++++------ packages/pastojs/tests/tcmodules.pas | 553 +++++++++++++++++++++-- 4 files changed, 1060 insertions(+), 187 deletions(-) diff --git a/packages/fcl-js/src/jstree.pp b/packages/fcl-js/src/jstree.pp index 58acbad68a..5c6b95e613 100644 --- a/packages/fcl-js/src/jstree.pp +++ b/packages/fcl-js/src/jstree.pp @@ -883,7 +883,7 @@ Type Destructor Destroy; override; Property Cond : TJSelement Read FCond Write FCond; Property Cases : TJSCaseElements Read FCases; - Property TheDefault : TJSCaseelement Read FDefault Write FDefault; // one of Cases + Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases end; { TJSLabeledStatement - e.g. 'TheLabel : A' } diff --git a/packages/fcl-js/src/jswriter.pp b/packages/fcl-js/src/jswriter.pp index d789625e6a..7046b11145 100644 --- a/packages/fcl-js/src/jswriter.pp +++ b/packages/fcl-js/src/jswriter.pp @@ -136,7 +136,7 @@ Type Procedure WriteIfStatement(El: TJSIfStatement);virtual; Procedure WriteSourceElements(El: TJSSourceElements);virtual; Procedure WriteStatementList(El: TJSStatementList);virtual; - Procedure WriteTryStatement(el: TJSTryStatement);virtual; + Procedure WriteTryStatement(El: TJSTryStatement);virtual; Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual; Procedure WriteWithStatement(El: TJSWithStatement);virtual; Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual; @@ -426,7 +426,7 @@ Var S : String; begin if V.CustomValue<>'' then - S:=V.CustomValue + S:=JSStringToStr(V.CustomValue) else Case V.ValueType of jstUNDEFINED : S:='undefined'; @@ -821,7 +821,7 @@ begin WriteJS(EL.LHS); S:=El.OperatorString; If Not (woCompact in Options) then - S:=' '+S+' '; + S:=' '+S+' '; Write(s); WriteJS(EL.Expr); end; @@ -841,11 +841,16 @@ procedure TJSWriter.WriteIfStatement(El: TJSIfStatement); begin Write('if ('); - WriteJS(EL.Cond); - Write(') '); - WriteJS(El.BTrue); + WriteJS(El.Cond); + Write(')'); + If Not (woCompact in Options) then + Write(' '); + if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then + WriteJS(El.BTrue); if Assigned(El.BFalse) then begin + if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then + Write('{}'); Write(' else '); WriteJS(El.BFalse) end; @@ -929,15 +934,15 @@ begin C:=(woCompact in Options); Write('switch ('); If Assigned(El.Cond) then - WriteJS(EL.Cond); + WriteJS(El.Cond); if C then Write(') {') else Writeln(') {'); - For I:=0 to EL.Cases.Count-1 do + For I:=0 to El.Cases.Count-1 do begin - EC:=EL.Cases[i]; - if EC=EL.TheDefault then + EC:=El.Cases[i]; + if EC=El.TheDefault then Write('default') else begin @@ -950,14 +955,22 @@ begin Writeln(':'); if Assigned(EC.Body) then begin + FSkipBrackets:=true; + Indent; WriteJS(EC.Body); + Undent; + if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then + if C then + Write('; ') + else + Writeln(';'); + end + else + begin if C then - begin - if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then - write('; ') - end + Write('; ') else - Writeln(''); + Writeln(';'); end; end; Write('}'); @@ -1017,7 +1030,7 @@ begin WriteJS(EL.A); end; -procedure TJSWriter.WriteTryStatement(el: TJSTryStatement); +procedure TJSWriter.WriteTryStatement(El: TJSTryStatement); Var C : Boolean; @@ -1034,7 +1047,6 @@ begin Write('} ') else begin - Writeln(''); Writeln('}'); end; If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then @@ -1045,7 +1057,7 @@ begin else Writeln(') {'); Indent; - WriteJS(EL.BCatch); + WriteJS(El.BCatch); Undent; If C then if (El is TJSTryCatchFinallyStatement) then @@ -1065,15 +1077,10 @@ begin else Writeln('finally {'); Indent; - WriteJS(EL.BFinally); + FSkipBrackets:=True; + WriteJS(El.BFinally); Undent; - If C then - Write('}') - else - begin - Writeln(''); - Writeln('}'); - end; + Write('}'); end; end; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index aff920c388..126e504005 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -34,22 +34,21 @@ - asm..end - type alias - inc/dec to += -= + - case-of + - use $impl for implementation declarations, can be disabled ToDos: - - use $impl + - arrays + - classes + - pass by reference + - create unique id for local const - append to for-loop: if($loopend>i)i--; - rename overloaded procs, append $0, $1, ... - rename js identifiers: apply, bind, call, prototyp, ... - - bug: try adds empty line - - bug: finally adds unnecessary {} - record const - copy record - asm..end as whole body - - arrays - - classes - - passing by reference - procedure modifier external - - Optional: put implementation into $impl - library - enums, sets. For small sets use an integer, for big sets use var s = {}; @@ -127,43 +126,43 @@ Type TConvertContext = Class(TObject) public PasElement: TPasElement; + JSElement: TJSElement; Resolver: TPasResolver; Parent: TConvertContext; Kind: TCtxJSElementKind; IsSingleton: boolean; - constructor Create(El: TPasElement; aParent: TConvertContext); + TmpVarCount: integer; + constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual; function GetRootModule: TPasModule; + function CreateTmpIdentifier(const Prefix: string): string; end; { TRootContext } TRootContext = Class(TConvertContext) public - constructor Create(El: TPasElement; aParent: TConvertContext); + constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override; end; { TFunctionContext } TFunctionContext = Class(TConvertContext) public - constructor Create(El: TPasElement; aParent: TConvertContext); + constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override; end; { TObjectContext } TObjectContext = Class(TConvertContext) public - constructor Create(El: TPasElement; aParent: TConvertContext); + constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override; end; { TInterfaceContext } TInterfaceContext = Class(TFunctionContext) - end; - - { TImplementationContext } - - TImplementationContext = Class(TObjectContext) + public + constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override; end; { TPasToJSConverter } @@ -171,14 +170,18 @@ Type TPasToJSConverter = Class(TObject) private FMainFunction: TJSString; - FNameSpace: TJSString; FUseLowerCase: boolean; + FImplementationName: TJSString; + FUseSwitchStatement: boolean; Procedure AddToSourceElements(Src: TJSSourceElements; El: TJSElement); Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent; Function CreateIdentifierExpr(AName: string; El: TPasElement): TJSPrimaryExpressionIdent; + Function CreateSubNameExpression(El: TPasElement; const Name: string; + AContext: TConvertContext): TJSPrimaryExpressionIdent; Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement; - Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext; TopLvl: boolean): TJSElement; - Function CreateConstDecl(El: TPasConst; AContext: TConvertContext; TopLvl: boolean): TJSElement; + Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext): TJSElement; + Function CreateConstDecl(El: TPasConst; AContext: TConvertContext): TJSElement; + Function CreateSwitchStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement; protected // Error functions Procedure DoError(Id: int64; Const Msg : String); @@ -192,15 +195,14 @@ Type Function GetPasIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual; Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: TJSString; inunary: boolean): TJSFunctionDeclarationStatement; Function GetFunctionUnaryName(var je: TJSElement;out fundec: TJSFunctionDeclarationStatement): TJSString; - Function GetSingletonParent(AContext: TConvertContext): TConvertContext; // Name mangling - Function TransFormIdent(El: TJSPrimaryExpressionIdent): TJSPrimaryExpressionIdent;virtual; + Function TransformIdent(El: TJSPrimaryExpressionIdent): TJSPrimaryExpressionIdent;virtual; Function TransformVariableName(Const AName: String; AContext : TConvertContext): String; virtual; Function TransformVariableName(El: TPasElement; AContext : TConvertContext) : String; virtual; Function TransformFunctionName(El: TPasElement; AContext : TConvertContext) : String; virtual; Function TransformModuleName(El: TPasModule; AContext : TConvertContext) : String; virtual; Function GetExceptionObjectName(AContext: TConvertContext) : string; - // Never create an element manually, always use the below function + // Never create an element manually, always use the below functions Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual; Function CreateCallStatement(const JSCallName: string; JSArgs: array of string): TJSCallExpression; Function CreateCallStatement(const FunNameEx: TJSElement; JSArgs: array of string): TJSCallExpression; @@ -215,6 +217,7 @@ Type Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement;virtual; Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;virtual; Function CreateTypeRef(El: TPasType; AContext : TConvertContext): TJSElement;virtual; + Function CreateReferencePath(El: TPasElement; AContext : TConvertContext): string;virtual; // Statements Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual; Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual; @@ -233,7 +236,9 @@ Type Function ConvertTryFinallyStatement(El: TPasImplTryFinally; AContext: TConvertContext): TJSElement;virtual; Function ConvertExceptOn(El: TPasImplExceptOn; AContext: TConvertContext): TJSElement; Function ConvertTryExceptStatement(El: TPasImplTryExcept; AContext: TConvertContext): TJSElement; + Function ConvertCaseOfStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement; Function ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement; + Procedure CreateImplementationSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); // Expressions Function ConvertArrayValues(El: TArrayValues; AContext : TConvertContext): TJSElement;virtual; @@ -276,9 +281,10 @@ Type Public constructor Create; Function ConvertPasElement(El : TPasElement; Resolver: TPasResolver) : TJSElement; - Property NameSpace : TJSString Read FNameSpace Write FNameSpace; - Property MainFunction : TJSString Read FMainFunction Write FMainFunction; + Property MainFunction: TJSString Read FMainFunction Write FMainFunction; + Property ImplementationName: TJSString read FImplementationName write FImplementationName;// empty to not use, default '$impl' Property UseLowerCase: boolean read FUseLowerCase write FUseLowerCase; + Property UseSwitchStatement: boolean read FUseSwitchStatement write FUseSwitchStatement;// default false, because slower than "if" in many engines end; EPasToJS = Class(Exception); @@ -288,9 +294,19 @@ var implementation +{ TInterfaceContext } + +constructor TInterfaceContext.Create(PasEl: TPasElement; JSEl: TJSElement; + aParent: TConvertContext); +begin + inherited; + IsSingleton:=true; +end; + { TObjectContext } -constructor TObjectContext.Create(El: TPasElement; aParent: TConvertContext); +constructor TObjectContext.Create(PasEl: TPasElement; JSEl: TJSElement; + aParent: TConvertContext); begin inherited; Kind:=cjkObject; @@ -298,7 +314,8 @@ end; { TFunctionContext } -constructor TFunctionContext.Create(El: TPasElement; aParent: TConvertContext); +constructor TFunctionContext.Create(PasEl: TPasElement; JSEl: TJSElement; + aParent: TConvertContext); begin inherited; Kind:=cjkFunction; @@ -306,7 +323,8 @@ end; { TRootContext } -constructor TRootContext.Create(El: TPasElement; aParent: TConvertContext); +constructor TRootContext.Create(PasEl: TPasElement; JSEl: TJSElement; + aParent: TConvertContext); begin inherited; Kind:=cjkRoot; @@ -314,9 +332,11 @@ end; { TConvertContext } -constructor TConvertContext.Create(El: TPasElement; aParent: TConvertContext); +constructor TConvertContext.Create(PasEl: TPasElement; JSEl: TJSElement; + aParent: TConvertContext); begin - PasElement:=El; + PasElement:=PasEl; + JSElement:=JsEl; Parent:=aParent; if Parent<>nil then Resolver:=Parent.Resolver; @@ -335,6 +355,12 @@ begin Result:=nil; end; +function TConvertContext.CreateTmpIdentifier(const Prefix: string): string; +begin + inc(TmpVarCount); + Result:=Prefix+IntToStr(TmpVarCount); +end; + { TPasToJSConverter } procedure TPasToJSConverter.AddToSourceElements(Src: TJSSourceElements; @@ -393,6 +419,8 @@ Var UsesSection: TPasSection; ModuleName: String; IntfContext: TInterfaceContext; + VarSt: TJSVariableStatement; + VarDecl: TJSVarDeclaration; begin Result:=Nil; OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El)); @@ -405,7 +433,7 @@ begin ArgArray := TJSArguments.Create(0, 0, ''); RegModuleCall.Args:=ArgArray; - // add parameter: unitname + // add unitname parameter: unitname ArgEx := TJSLiteral.Create(0,0); ModuleName:=El.Name; if El is TPasProgram then @@ -413,7 +441,7 @@ begin ArgEx.Value.AsString:=TJSString(TransformVariableName(ModuleName,AContext)); ArgArray.Elements.AddElement.Expr:=ArgEx; - // add parameter: [,, ...] + // add interface-uses-section parameter: [,, ...] UsesSection:=nil; if (El is TPasProgram) then UsesSection:=TPasProgram(El).ProgramSection @@ -424,7 +452,7 @@ begin UsesList:=UsesSection.UsesList; ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesList,AContext); - // add parameter: function(){} + // add interface parameter: function(){} FunDecl:=TJSFunctionDeclarationStatement.Create(0,0); ArgArray.Elements.AddElement.Expr:=FunDecl; FunDef:=TJSFuncDef.Create; @@ -435,7 +463,7 @@ begin Src:=TJSSourceElements(CreateElement(TJSSourceElements, El)); FunBody.A:=Src; - IntfContext:=TInterfaceContext.Create(El,AContext); + IntfContext:=TInterfaceContext.Create(El,Src,AContext); try if (El is TPasProgram) then begin // program @@ -452,12 +480,19 @@ begin else begin // unit // add interface section + if (ImplementationName<>'') and Assigned(El.ImplementationSection) then + begin + // add 'var $impl = {};' + VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El)); + AddToSourceElements(Src,VarSt); + VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El)); + VarSt.A:=VarDecl; + VarDecl.Name:=String(ImplementationName); + VarDecl.Init:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El.ImplementationSection)); + end; if Assigned(El.InterfaceSection) then AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext)); - // add implementation section - if Assigned(El.ImplementationSection) then - // ToDo: add implementation context - AddToSourceElements(Src,ConvertDeclarations(El.ImplementationSection,IntfContext)); + CreateImplementationSection(El,Src,IntfContext); CreateInitSection(El,Src,IntfContext); // add optional implementation uses list: [,, ...] @@ -476,9 +511,14 @@ end; function TPasToJSConverter.CreateElement(C: TJSElementClass; Src: TPasElement ): TJSElement; +var + Line, Col: Integer; begin if Assigned(Src) then - Result:=C.Create(Src.SourceLinenumber,1,Src.SourceFilename) + begin + TPasResolver.UnmangleSourceLineNumber(Src.SourceLinenumber,Line,Col); + Result:=C.Create(Line,Col,Src.SourceFilename); + end else Result:=C.Create(0,0); end; @@ -726,7 +766,7 @@ begin end; end; -function TPasToJSConverter.TransFormIdent(El: TJSPrimaryExpressionIdent +function TPasToJSConverter.TransformIdent(El: TJSPrimaryExpressionIdent ): TJSPrimaryExpressionIdent; begin @@ -746,7 +786,23 @@ begin if UseLowerCase then AName:=LowerCase(AName); I.Name:=TJSString(AName); - Result:=TransFormIdent(I); + Result:=I; +end; + +function TPasToJSConverter.CreateSubNameExpression(El: TPasElement; + const Name: string; AContext: TConvertContext): TJSPrimaryExpressionIdent; +var + CurName: String; +begin + CurName:=TransformVariableName(Name,AContext); + if UseLowerCase then + CurName:=LowerCase(CurName); + if (ImplementationName<>'') and (El.Parent.ClassType=TImplementationSection) then + CurName:=String(ImplementationName)+'.'+CurName + else + CurName:='this.'+CurName; + Result:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El)); + Result.Name:=TJSString(CurName); end; function TPasToJSConverter.ConvertPrimitiveExpression(El: TPrimitiveExpr; @@ -819,7 +875,6 @@ function TPasToJSConverter.ConvertIdentifierExpr(El: TPrimitiveExpr; var Decl: TPasElement; Name: String; - FoundModule: TPasModule; begin if AContext=nil then ; if El.Kind<>pekIdent then @@ -840,16 +895,7 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertIdentifierExpr Decl.Parent=',GetObjName(Decl.Parent)); {$ENDIF} - if Decl.Parent is TPasSection then - begin - FoundModule:=Decl.GetModule; - if FoundModule=nil then - RaiseInconsistency(20161024191259); - if AContext.GetRootModule=FoundModule then - Name:='this.'+Name - else - Name:='pas.'+TransformModuleName(FoundModule,AContext)+'.'+Name; - end; + Name:=CreateReferencePath(Decl,AContext)+Name; end; // ToDo: use TJSDotMemberExpression for dots Result:=CreateIdentifierExpr(Name,El); @@ -925,11 +971,11 @@ begin Case El.Kind of pekFuncParams : begin - writeln('TPasToJSConverter.ConvertParamsExpression AAA1 ',GetObjName(El.CustomData),' ',GetObjName(El.Value.CustomData)); + //writeln('TPasToJSConverter.ConvertParamsExpression START pekFuncParams ',GetObjName(El.CustomData),' ',GetObjName(El.Value.CustomData)); if El.Value.CustomData is TResolvedReference then begin Ref:=TResolvedReference(El.Value.CustomData); - writeln('TPasToJSConverter.ConvertParamsExpression AAA2 ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData)); + //writeln('TPasToJSConverter.ConvertParamsExpression pekFuncParams TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData)); if Ref.Declaration.CustomData is TResElDataBuiltInProc then begin BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData); @@ -1089,28 +1135,36 @@ begin end; function TPasToJSConverter.CreateVarDecl(El: TPasVariable; - AContext: TConvertContext; TopLvl: boolean): TJSElement; + AContext: TConvertContext): TJSElement; Var C : TJSElement; V : TJSVariableStatement; AssignSt: TJSSimpleAssignStatement; - VarName: String; + Obj: TJSObjectLiteral; + ObjLit: TJSObjectLiteralElement; begin - if TopLvl then + if AContext is TObjectContext then + begin + // create 'A: initvalue' + Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral; + ObjLit:=Obj.Elements.AddElement; + ObjLit.Name:=TJSString(TransformVariableName(El.Name,AContext)); + ObjLit.Expr:=CreateVarInit(El,AContext); + end + else if AContext.IsSingleton then begin // create 'this.A=initvalue' AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); Result:=AssignSt; - VarName:=TransformVariableName(El.Name,AContext); - AssignSt.LHS:=CreateMemberExpression(['this',VarName]); + AssignSt.LHS:=CreateSubNameExpression(El,El.Name,AContext); AssignSt.Expr:=CreateVarInit(El,AContext); end else begin // create 'var A=initvalue' - C:=ConvertElement(El,AContext); + C:=ConvertVariable(El,AContext); V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El)); V.A:=C; Result:=V; @@ -1118,19 +1172,110 @@ begin end; function TPasToJSConverter.CreateConstDecl(El: TPasConst; - AContext: TConvertContext; TopLvl: boolean): TJSElement; + AContext: TConvertContext): TJSElement; Var AssignSt: TJSSimpleAssignStatement; - VarName: String; + Obj: TJSObjectLiteral; + ObjLit: TJSObjectLiteralElement; begin - // create 'this.A=initvalue' - AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); - Result:=AssignSt; - VarName:=TransformVariableName(El.Name,AContext); - AssignSt.LHS:=CreateMemberExpression(['this',VarName]); - AssignSt.Expr:=CreateVarInit(El,AContext); + if AContext is TObjectContext then + begin + // create 'A: initvalue' + Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral; + ObjLit:=Obj.Elements.AddElement; + ObjLit.Name:=TJSString(TransformVariableName(El.Name,AContext)); + ObjLit.Expr:=CreateVarInit(El,AContext); + end + else + begin + if not AContext.IsSingleton then begin + // local const are stored in interface/implementation + //GetSingletonParent(); + + // ToDo: avoid name clash + RaiseNotSupported(El,AContext,20161127165213,'todo: check for name clash and rename'); + end; + // create 'this.A=initvalue' + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + Result:=AssignSt; + AssignSt.LHS:=CreateSubNameExpression(El,El.Name,AContext); + AssignSt.Expr:=CreateVarInit(El,AContext); + end; +end; + +function TPasToJSConverter.CreateSwitchStatement(El: TPasImplCaseOf; + AContext: TConvertContext): TJSElement; +var + SwitchEl: TJSSwitchStatement; + JSCaseEl: TJSCaseElement; + SubEl: TPasImplElement; + St: TPasImplCaseStatement; + ok: Boolean; + i, j: Integer; + BreakSt: TJSBreakStatement; + BodySt: TJSElement; + StList: TJSStatementList; + Expr: TPasExpr; +begin + Result:=nil; + SwitchEl:=TJSSwitchStatement(CreateElement(TJSSwitchStatement,El)); + ok:=false; + try + SwitchEl.Cond:=ConvertExpression(El.CaseExpr,AContext); + for i:=0 to El.Elements.Count-1 do + begin + SubEl:=TPasImplElement(El.Elements[i]); + if not (SubEl is TPasImplCaseStatement) then + continue; + St:=TPasImplCaseStatement(SubEl); + JSCaseEl:=nil; + for j:=0 to St.Expressions.Count-1 do + begin + Expr:=TPasExpr(St.Expressions[j]); + JSCaseEl:=SwitchEl.Cases.AddCase; + JSCaseEl.Expr:=ConvertExpression(Expr,AContext); + end; + BodySt:=nil; + if St.Body<>nil then + BodySt:=ConvertElement(St.Body,AContext); + // add break + BreakSt:=TJSBreakStatement(CreateElement(TJSBreakStatement,St)); + if BodySt=nil then + // no Pascal statement -> add only one 'break;' + BodySt:=BreakSt + else + begin + if (BodySt is TJSStatementList) then + begin + // list of statements -> append 'break;' to end + StList:=TJSStatementList(BodySt); + AddToStatementList(TJSStatementList(BodySt),StList,BreakSt,St); + end + else + begin + // single statement -> create list of old and 'break;' + StList:=TJSStatementList(CreateElement(TJSStatementList,St)); + StList.A:=BodySt; + StList.B:=BreakSt; + BodySt:=StList; + end; + end; + JSCaseEl.Body:=BodySt; + end; + if El.ElseBranch<>nil then + begin + JSCaseEl:=SwitchEl.Cases.AddCase; + JSCaseEl.Body:=ConvertImplBlockElements(El.ElseBranch,AContext); + SwitchEl.TheDefault:=JSCaseEl; + end; + ok:=true; + finally + if not ok then + SwitchEl.Free; + end; + Result:=SwitchEl; end; function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations; @@ -1142,6 +1287,21 @@ Var P: TPasElement; IsTopLvl, IsProcBody, IsFunction: boolean; I : Integer; + PasProc: TPasProcedure; + ProcScope: TPasProcedureScope; + + Procedure Add(NewEl: TJSElement); + begin + if AContext is TObjectContext then + begin + // NewEl is already added + end + else + begin + AddToStatementList(SLFirst,SLLast,NewEl,El); + ConvertDeclarations:=SLFirst; + end; + end; Procedure AddFunctionResultInit; var @@ -1157,7 +1317,7 @@ Var // add 'var result=initvalue' VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El)); - AddToStatementList(SLFirst,SLLast,VarSt,El); + Add(VarSt); Result:=SLFirst; AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); VarSt.A:=AssignSt; @@ -1171,7 +1331,7 @@ Var begin RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El)); RetSt.Expr:=CreateBuiltInIdentifierExpr(ResolverResultVar); - AddToStatementList(SLFirst,SLLast,RetSt,El); + Add(RetSt); end; begin @@ -1188,7 +1348,7 @@ begin SLFirst:=nil; SLLast:=nil; - IsTopLvl:=El.Parent is TPasModule; + IsTopLvl:=AContext.IsSingleton; IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil); IsFunction:=IsProcBody and (El.Parent is TPasFunction); @@ -1199,38 +1359,44 @@ begin begin E:=Nil; P:=TPasElement(El.Declarations[i]); - //writeln('TPasToJSConverter.ConvertDeclarations El[i]=',GetObjName(P)); + //writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P)); if P.ClassType=TPasConst then begin + E:=CreateConstDecl(TPasConst(P),aContext); if not IsTopLvl then - begin - // const are stored in interface/implementation - //GetSingletonParent(); - end; - E:=CreateConstDecl(TPasConst(P),aContext,IsTopLvl); - if not IsTopLvl then + // const was added to higher context continue; end else if P.ClassType=TPasVariable then - E:=CreateVarDecl(TPasVariable(P),aContext,IsTopLvl) + E:=CreateVarDecl(TPasVariable(P),aContext) else if P is TPasType then E:=CreateTypeDecl(TPasType(P),aContext) else if P is TPasProcedure then - E:=ConvertProcedure(TPasProcedure(P),aContext) + begin + PasProc:=TPasProcedure(P); + if PasProc.IsForward then continue; // JavaScript does not need the forward + ProcScope:=TPasProcedureScope(PasProc.CustomData); + if (ProcScope.DeclarationProc<>nil) + and (PasProc.Parent.ClassType=TImplementationSection) then + continue; // this proc was already converted in interface or class + if ProcScope.ImplProc<>nil then + P:=ProcScope.ImplProc; + E:=ConvertProcedure(TPasProcedure(P),aContext); + if (Pos('.', P.Name) > 0) then + begin + AddProcedureToClass(TJSStatementList(Result), E, P as TPasProcedure); + continue; + end; + end else RaiseNotSupported(P as TPasElement,AContext,20161024191434); - if (Pos('.', P.Name) > 0) then - AddProcedureToClass(TJSStatementList(Result), E, P as TPasProcedure) - else - AddToStatementList(SLFirst,SLLast,E,El); - Result:=SLFirst; + Add(E); end; if IsProcBody and (TProcedureBody(El).Body.Elements.Count>0) then begin E:=ConvertElement(TProcedureBody(El).Body,aContext); - AddToStatementList(SLFirst,SLLast,E,El); - Result:=SLFirst; + Add(E); end; if IsProcBody and IsFunction then @@ -1280,11 +1446,12 @@ var FD: TJSFuncDef; cons: TJSFunctionDeclarationStatement; FS: TJSFunctionDeclarationStatement; - tmember: TPasElement; + aMember: TPasElement; j: integer; ret: TJSReturnStatement; jsName: String; FuncContext: TFunctionContext; + Src: TJSSourceElements; begin //ctname := El.FullName; jsName:=TransformVariableName(El.Name,AContext); @@ -1300,9 +1467,10 @@ begin FD := TJSFuncDef.Create; FS.AFunction := FD; FD.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El)); - FD.Body.A := TJSSourceElements(CreateElement(TJSSourceElements, El)); + Src:=TJSSourceElements(CreateElement(TJSSourceElements, El)); + FD.Body.A := Src; - FuncContext:=TFunctionContext.Create(El,AContext); + FuncContext:=TFunctionContext.Create(El,Src,AContext); try if Assigned(El.AncestorType) then begin @@ -1319,12 +1487,12 @@ begin TJSSourceElements(FD.Body.A).Statements.AddNode.Node := cons; cons.AFunction.Name := TJSString(jsName); - //convert class member + //convert class members for j := 0 to El.Members.Count - 1 do begin - tmember := TPasElement(El.Members[j]); - //memname := tmember.FullName; - je := ConvertClassMember(tmember, FuncContext); + aMember := TPasElement(El.Members[j]); + //memname := aMember.FullName; + je := ConvertClassMember(aMember, FuncContext); if Assigned(je) then TJSSourceElements(FD.Body.A).Statements.AddNode.Node := je; end; @@ -1393,6 +1561,7 @@ end; constructor TPasToJSConverter.Create; begin FUseLowerCase:=true; + FImplementationName:='$impl'; end; function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; @@ -1409,7 +1578,11 @@ Var begin Result:=nil; - IsTopLvl:=El.Parent is TPasSection; + IsTopLvl:=AContext.IsSingleton; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" ',El.Parent.ClassName); + {$ENDIF} FunName:=TransformFunctionName(El,AContext); @@ -1434,12 +1607,15 @@ begin FD.Params.Add(TransformVariableName(TPasArgument(El.ProcType.Args[n]).Name,AContext)); FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El.Body)); - FuncContext:=TFunctionContext.Create(El,AContext); - try - FD.Body.A:=ConvertDeclarations(El.Body,FuncContext); - finally - FuncContext.Free; - end; + if El.Body<>nil then + begin + FuncContext:=TFunctionContext.Create(El,FD.Body,AContext); + try + FD.Body.A:=ConvertDeclarations(El.Body,FuncContext); + finally + FuncContext.Free; + end; + end; { TPasProcedureBase = class(TPasElement) TPasOverloadedProc = class(TPasProcedureBase) @@ -1502,15 +1678,17 @@ begin // create: 'this.$init=function(){}' IsMain:=(El.Parent<>nil) and (El.Parent is TPasProgram); - if IsMain then - FunName:='$main' - else - FunName:='$init'; + FunName:=String(MainFunction); + if FunName='' then + if IsMain then + FunName:='$main' + else + FunName:='$init'; AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); Result:=AssignSt; + FuncContext:=nil; ok:=false; - FuncContext:=TFunctionContext.Create(El,AContext); try AssignSt.LHS:=CreateMemberExpression(['this',FunName]); FDS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El)); @@ -1520,6 +1698,7 @@ begin if El.Elements.Count>0 then begin FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El)); + FuncContext:=TFunctionContext.Create(El,FD.Body,AContext); FD.Body.A:=ConvertImplBlockElements(El,FuncContext); end; ok:=true; @@ -1588,6 +1767,149 @@ begin Result:=ConvertImplBlockElements(El,AContext); end; +function TPasToJSConverter.ConvertCaseOfStatement(El: TPasImplCaseOf; + AContext: TConvertContext): TJSElement; +var + SubEl: TPasImplElement; + St: TPasImplCaseStatement; + ok: Boolean; + i, j: Integer; + JSExpr: TJSElement; + StList: TJSStatementList; + Expr: TPasExpr; + IfSt, LastIfSt: TJSIfStatement; + TmpVarName: String; + VarDecl: TJSVarDeclaration; + VarSt: TJSVariableStatement; + JSOrExpr: TJSLogicalOrExpression; + JSAndExpr: TJSLogicalAndExpression; + JSLEExpr: TJSRelationalExpressionLE; + JSGEExpr: TJSRelationalExpressionGE; + JSEQExpr: TJSEqualityExpressionEQ; +begin + Result:=nil; + if UseSwitchStatement then + begin + // convert to switch statement + // switch does not support ranges -> check + ok:=true; + for i:=0 to El.Elements.Count-1 do + begin + SubEl:=TPasImplElement(El.Elements[i]); + if not (SubEl is TPasImplCaseStatement) then + continue; + St:=TPasImplCaseStatement(SubEl); + for j:=0 to St.Expressions.Count-1 do + begin + Expr:=TPasExpr(St.Expressions[j]); + if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then + begin + ok:=false; + break; + end; + end; + if not ok then break; + end; + if ok then + begin + Result:=CreateSwitchStatement(El,AContext); + exit; + end; + end; + + // convert to if statements + StList:=TJSStatementList(CreateElement(TJSStatementList,El)); + ok:=false; + try + // create var $tmp=CaseExpr; + TmpVarName:=AContext.CreateTmpIdentifier('$tmp'); + VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El.CaseExpr)); + StList.A:=VarSt; + VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El.CaseExpr)); + VarSt.A:=VarDecl; + VarDecl.Name:=TmpVarName; + VarDecl.Init:=ConvertExpression(El.CaseExpr,AContext); + + LastIfSt:=nil; + for i:=0 to El.Elements.Count-1 do + begin + SubEl:=TPasImplElement(El.Elements[i]); + if SubEl is TPasImplCaseStatement then + begin + St:=TPasImplCaseStatement(SubEl); + // create for example "if (tmp==expr) || ((tmp>=expr) && (tmp<=expr)){}" + IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,SubEl)); + if LastIfSt=nil then + StList.B:=IfSt + else + LastIfSt.BFalse:=IfSt; + LastIfSt:=IfSt; + + for j:=0 to St.Expressions.Count-1 do + begin + Expr:=TPasExpr(St.Expressions[j]); + if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then + begin + // range -> create "(tmp>=left) && (tmp<=right)" + // create "() && ()" + JSAndExpr:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression,Expr)); + JSExpr:=JSAndExpr; + // create "tmp>=left" + JSGEExpr:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,Expr)); + JSAndExpr.A:=JSGEExpr; + JSGEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr); + JSGEExpr.B:=ConvertExpression(TBinaryExpr(Expr).left,AContext); + // create "tmp<=right" + JSLEExpr:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,Expr)); + JSAndExpr.B:=JSLEExpr; + JSLEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr); + JSLEExpr.B:=ConvertExpression(TBinaryExpr(Expr).right,AContext); + end + else + begin + // value -> create (tmp==Expr) + JSEQExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,Expr)); + JSExpr:=JSEQExpr; + JSEQExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr); + JSEQExpr.B:=ConvertExpression(Expr,AContext); + end; + if IfSt.Cond=nil then + // first expression + IfSt.Cond:=JSExpr + else + begin + // multi expression -> append with OR + JSOrExpr:=TJSLogicalOrExpression(CreateElement(TJSLogicalOrExpression,St)); + JSOrExpr.A:=IfSt.Cond; + JSOrExpr.B:=JSExpr; + IfSt.Cond:=JSOrExpr; + end; + end; + // convert statement + if St.Body<>nil then + IfSt.BTrue:=ConvertElement(St.Body,AContext) + else + IfSt.BTrue:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,St)); + end + else if SubEl is TPasImplCaseElse then + begin + // Pascal 'else' or 'otherwise' -> create JS "else{}" + if LastIfSt=nil then + RaiseNotSupported(SubEl,AContext,20161128120802,'case-of needs at least one case'); + LastIfSt.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext); + end + else + RaiseNotSupported(SubEl,AContext,20161128113055); + end; + + ok:=true; + finally + if not ok then + StList.Free; + end; + Result:=StList; +end; + function TPasToJSConverter.ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement; var @@ -1605,6 +1927,35 @@ begin end; end; +procedure TPasToJSConverter.CreateImplementationSection(El: TPasModule; + Src: TJSSourceElements; AContext: TConvertContext); +var + AssignSt: TJSSimpleAssignStatement; + Section: TImplementationSection; +begin + if not Assigned(El.ImplementationSection) then + exit; + Section:=El.ImplementationSection; + // add implementation section + if ImplementationName<>'' then + begin + // add separat implementation object + + // add 'this.$impl = $impl;' + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + AddToSourceElements(Src,AssignSt); + AssignSt.LHS:=CreateBuiltInIdentifierExpr('this.'+String(ImplementationName)); + AssignSt.Expr:=CreateBuiltInIdentifierExpr(String(ImplementationName)); + + AddToSourceElements(Src,ConvertDeclarations(Section,AContext)); + end + else + begin + // merge interface and implementation + AddToSourceElements(Src,ConvertDeclarations(Section,AContext)); + end; +end; + procedure TPasToJSConverter.CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); begin @@ -1639,6 +1990,8 @@ begin Result:=ConvertTryFinallyStatement(TPasImplTryFinally(El),AContext) else if (El.ClassType=TPasImplTryExcept) then Result:=ConvertTryExceptStatement(TPasImplTryExcept(El),AContext) + else if (El.ClassType=TPasImplCaseOf) then + Result:=ConvertCaseOfStatement(TPasImplCaseOf(El),AContext) else RaiseNotSupported(El,AContext,20161024192156); (* @@ -2189,13 +2542,6 @@ begin Result := cname; end; -function TPasToJSConverter.GetSingletonParent(AContext: TConvertContext - ): TConvertContext; -begin - Result:=nil; - RaiseInconsistency(20161024192734); -end; - function TPasToJSConverter.CreateUsesList(UsesList: TFPList; AContext: TConvertContext): TJSArrayLiteral; var @@ -2273,6 +2619,8 @@ begin else begin // add to chain + while Last.B is TJSStatementList do + Last:=TJSStatementList(Last.B); SL2:=TJSStatementList(CreateElement(TJSStatementList,Src)); SL2.A:=Last.B; Last.B:=SL2; @@ -2363,25 +2711,37 @@ end; function TPasToJSConverter.CreateTypeRef(El: TPasType; AContext: TConvertContext ): TJSElement; var - FoundModule: TPasModule; Name: String; begin Name:=TransformVariableName(El.Name,AContext); {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.CreateTypeRef El="',GetObjName(El),'" El.Parent=',GetObjName(El.Parent)); {$ENDIF} + Name:=CreateReferencePath(El,AContext)+Name; + Result:=CreateIdentifierExpr(Name,El); +end; + +function TPasToJSConverter.CreateReferencePath(El: TPasElement; + AContext: TConvertContext): string; +var + FoundModule: TPasModule; +begin + Result:=''; if El.Parent is TPasSection then begin FoundModule:=El.GetModule; if FoundModule=nil then RaiseInconsistency(20161024192755); if AContext.GetRootModule=FoundModule then - Name:='this.'+Name + begin + if (ImplementationName<>'') and (El.Parent.ClassType=TImplementationSection) then + Result:=String(ImplementationName)+'.' + else + Result:='this.'; + end else - Name:='pas.'+TransformModuleName(FoundModule,AContext)+'.'+Name; + Result:='pas.'+TransformModuleName(FoundModule,AContext)+'.'; end; - // ToDo: use TJSDotMemberExpression for dots - Result:=CreateIdentifierExpr(Name,El); end; function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement @@ -2541,9 +2901,9 @@ function TPasToJSConverter.ConvertRecordType(El: TPasRecordType; end; this.TMyRecord=function() { - i=0; - s=""; - d=0.0; + this.i=0; + this.s=""; + this.d=0.0; }; *) var @@ -2556,33 +2916,50 @@ var JSVar: TJSElement; First, Last: TJSStatementList; FuncContext: TFunctionContext; + Obj: TJSObjectLiteral; + ObjLit: TJSObjectLiteralElement; begin - AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); - Result:=AssignSt; ok:=false; FuncContext:=nil; + AssignSt:=nil; try - AssignSt.LHS:=CreateMemberExpression(['this',TransformVariableName(El.Name,AContext)]); FDS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El)); - AssignSt.Expr:=FDS; + if AContext is TObjectContext then + begin + // add 'TypeName: function(){}' + Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral; + ObjLit:=Obj.Elements.AddElement; + ObjLit.Name:=TJSString(TransformVariableName(El.Name,AContext)); + ObjLit.Expr:=FDS; + end + else + begin + // add 'this.TypeName = function(){}' + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); + AssignSt.LHS:=CreateSubNameExpression(El,El.Name,AContext); + AssignSt.Expr:=FDS; + end; FD:=TJSFuncDef.Create; FDS.AFunction:=FD; + // add variables FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El)); - FuncContext:=TFunctionContext.Create(El,AContext); + FuncContext:=TFunctionContext.Create(El,FD.Body,AContext); + FuncContext.IsSingleton:=true; First:=nil; Last:=nil; for i:=0 to El.Members.Count-1 do begin PasVar:=TPasVariable(El.Members[i]); - JSVar:=ConvertVariable(PasVar,AContext); + JSVar:=CreateVarDecl(PasVar,FuncContext); AddToStatementList(First,Last,JSVar,PasVar); FD.Body.A:=First; end; ok:=true; finally FuncContext.Free; - if not ok then FreeAndNil(Result); + if not ok then AssignSt.Free; end; + Result:=AssignSt; end; procedure TPasToJSConverter.DoError(Id: int64; const Msg: String); @@ -2690,7 +3067,7 @@ function TPasToJSConverter.ConvertPasElement(El: TPasElement; var aContext: TRootContext; begin - aContext:=TRootContext.Create(El,nil); + aContext:=TRootContext.Create(El,nil,nil); try aContext.Resolver:=Resolver; Result:=ConvertElement(El,aContext); diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 50ad1046e8..90c3362c4d 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -14,7 +14,8 @@ ********************************************************************** Examples: - ./testpas2js --suite=TTestModuleConverter.TestEmptyProgram + ./testpas2js --suite=TTestModule.TestEmptyProgram + ./testpas2js --suite=TTestModule.TestEmptyUnit } unit tcmodules; @@ -92,8 +93,9 @@ type procedure TearDown; override; Procedure Add(Line: string); Procedure StartParsing; - Procedure ParseModule; + procedure ParseModule; procedure ParseProgram; + procedure ParseUnit; protected function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; function AddModule(aFilename: string): TTestEnginePasResolver; @@ -102,7 +104,10 @@ type ImplementationSrc: string): TTestEnginePasResolver; procedure AddSystemUnit; procedure StartProgram(NeedSystemUnit: boolean); + procedure StartUnit(NeedSystemUnit: boolean); + Procedure ConvertModule; Procedure ConvertProgram; + Procedure ConvertUnit; procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string); function GetDottedIdentifier(El: TJSElement): string; procedure CheckSource(Msg,Statements, InitStatements: string); @@ -128,10 +133,31 @@ type property Scanner: TPascalScanner read FScanner; property Parser: TTestPasParser read FParser; Published + // modules Procedure TestEmptyProgram; + Procedure TestEmptyUnit; + + // vars/const Procedure TestVarInt; + Procedure TestVarBaseTypes; + Procedure TestConstBaseTypes; + Procedure TestUnitImplVars; + Procedure TestUnitImplConsts; + Procedure TestUnitImplRecord; + Procedure TestEmptyProc; + Procedure TestAliasTypeRef; + + // functions + Procedure TestPrgProcVar; Procedure TestProcTwoArgs; + Procedure TestUnitProcVar; + + // ToDo: enums + + // statements + Procedure TestIncDec; + Procedure TestAssignments; Procedure TestFunctionInt; Procedure TestFunctionString; Procedure TestVarRecord; @@ -140,6 +166,11 @@ type Procedure TestRepeatUntil; Procedure TestAsmBlock; Procedure TestTryFinally; + Procedure TestCaseOf; + Procedure TestCaseOf_UseSwitch; + Procedure TestCaseOfNoElse; + Procedure TestCaseOfNoElse_UseSwitch; + Procedure TestCaseOfRange; end; function LinesToStr(Args: array of const): string; @@ -365,22 +396,15 @@ begin end; procedure TTestModule.ParseModule; -begin - StartParsing; - Parser.ParseMain(FModule); - AssertNotNull('Module resulted in Module',FModule); - AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name); -end; - -procedure TTestModule.ParseProgram; begin FFirstPasStatement:=nil; try - ParseModule; + StartParsing; + Parser.ParseMain(FModule); except on E: EParserError do begin - writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message + writeln('ERROR: TTestModule.ParseModule Parser: '+E.ClassName+':'+E.Message +' File='+Scanner.CurFilename +' LineNo='+IntToStr(Scanner.CurRow) +' Col='+IntToStr(Scanner.CurColumn) @@ -390,7 +414,7 @@ begin end; on E: EPasResolve do begin - writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message + writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message +' File='+Scanner.CurFilename +' LineNo='+IntToStr(Scanner.CurRow) +' Col='+IntToStr(Scanner.CurColumn) @@ -400,11 +424,18 @@ begin end; on E: Exception do begin - writeln('ERROR: TTestModule.ParseProgram Exception: '+E.ClassName+':'+E.Message); + writeln('ERROR: TTestModule.ParseModule Exception: '+E.ClassName+':'+E.Message); raise E; end; end; + AssertNotNull('Module resulted in Module',FModule); + AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name)); TAssert.AssertSame('Has resolver',Engine,Parser.Engine); +end; + +procedure TTestModule.ParseProgram; +begin + ParseModule; AssertEquals('Has program',TPasProgram,Module.ClassType); FPasProgram:=TPasProgram(Module); AssertNotNull('Has program section',PasProgram.ProgramSection); @@ -414,6 +445,18 @@ begin FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]); end; +procedure TTestModule.ParseUnit; +begin + ParseModule; + AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType); + AssertNotNull('Has interface section',Module.InterfaceSection); + AssertNotNull('Has implementation section',Module.ImplementationSection); + if (Module.InitializationSection<>nil) + and (Module.InitializationSection.Elements.Count>0) + and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then + FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]); +end; + function TTestModule.FindModuleWithFilename(aFilename: string ): TTestEnginePasResolver; var @@ -488,20 +531,29 @@ begin Add(''); end; -procedure TTestModule.ConvertProgram; +procedure TTestModule.StartUnit(NeedSystemUnit: boolean); +begin + if NeedSystemUnit then + AddSystemUnit + else + Parser.ImplicitUses.Clear; + Add('unit Test1;'); + Add(''); +end; + +procedure TTestModule.ConvertModule; var ModuleNameExpr: TJSLiteral; FunDecl, InitFunction: TJSFunctionDeclarationStatement; FunDef: TJSFuncDef; InitAssign: TJSSimpleAssignStatement; FunBody: TJSFunctionBody; + InitName: String; begin - FJSSource:=TStringList.Create; - Add('end.'); - ParseProgram; FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements; + FJSSource:=TStringList.Create; FJSSource.Text:=JSToStr(JSModule); - writeln('TTestModule.ConvertProgram JS:'); + writeln('TTestModule.ConvertModule JS:'); write(FJSSource.Text); // rtl.module(... @@ -519,7 +571,10 @@ begin AssertNotNull('module name param',JSModuleCallArgs.Elements.Elements[0].Expr); ModuleNameExpr:=JSModuleCallArgs.Elements.Elements[0].Expr as TJSLiteral; AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType)); - AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString)); + if Module is TPasProgram then + AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString)) + else + AssertEquals('module name',lowercase(Module.Name),String(ModuleNameExpr.Value.AsString)); // main uses section AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr); @@ -538,12 +593,39 @@ begin FJSModuleSrc:=FunBody.A as TJSSourceElements; // init this.$main - the last statement - AssertEquals('this.$main function 1',true,JSModuleSrc.Statements.Count>0); - InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement; - CheckDottedIdentifier('init function',InitAssign.LHS,'this.$main'); + if Module is TPasProgram then + begin + InitName:='$main'; + AssertEquals('this.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0); + end + else + InitName:='$init'; + FJSInitBody:=nil; + if JSModuleSrc.Statements.Count>0 then + begin + InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement; + if GetDottedIdentifier(InitAssign.LHS)='this.'+InitName then + begin + InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement; + FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody; + end + else if Module is TPasProgram then + CheckDottedIdentifier('init function',InitAssign.LHS,'this.'+InitName); + end; +end; - InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement; - FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody; +procedure TTestModule.ConvertProgram; +begin + Add('end.'); + ParseProgram; + ConvertModule; +end; + +procedure TTestModule.ConvertUnit; +begin + Add('end.'); + ParseUnit; + ConvertModule; end; procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement; @@ -556,7 +638,7 @@ begin else begin AssertNotNull(Msg,El); - AssertEquals(Msg,DottedName,GetDottedIdentifier(EL)); + AssertEquals(Msg,DottedName,GetDottedIdentifier(El)); end; end; @@ -574,13 +656,20 @@ end; procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string); var - ActualSrc, ExpectedSrc: String; + ActualSrc, ExpectedSrc, InitName: String; begin ActualSrc:=JSToStr(JSModuleSrc); - ExpectedSrc:=Statements+LineEnding - +'this.$main = function () {'+LineEnding - +InitStatements - +'};'+LineEnding; + ExpectedSrc:=Statements; + if Module is TPasProgram then + InitName:='$main' + else + InitName:='$init'; + if (Module is TPasProgram) or (InitStatements<>'') then + ExpectedSrc:=ExpectedSrc+LineEnding + +'this.'+InitName+' = function () {'+LineEnding + +InitStatements + +'};'+LineEnding; + //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"'); CheckDiff(Msg,ExpectedSrc,ActualSrc); end; @@ -696,6 +785,14 @@ begin CheckSource('Empty program','',''); end; +procedure TTestModule.TestEmptyUnit; +begin + StartUnit(false); + Add('interface'); + Add('implementation'); + ConvertUnit; +end; + procedure TTestModule.TestVarInt; begin StartProgram(false); @@ -705,6 +802,70 @@ begin CheckSource('TestVarInt','this.i=0;',''); end; +procedure TTestModule.TestVarBaseTypes; +begin + StartProgram(false); + Add('var'); + Add(' i: longint;'); + Add(' s: string;'); + Add(' c: char;'); + Add(' b: boolean;'); + Add(' d: double;'); + Add(' i2: longint = 3;'); + Add(' s2: string = ''foo'';'); + Add(' c2: char = ''4'';'); + Add(' b2: boolean = true;'); + Add(' d2: double = 5.6;'); + Add(' i3: longint = $707;'); + Add(' i4: int64 = 4503599627370495;'); + Add(' i5: int64 = -4503599627370496;'); + Add(' i6: int64 = $fffffffffffff;'); + Add(' i7: int64 = -$10000000000000;'); + Add('begin'); + ConvertProgram; + CheckSource('TestVarBaseTypes', + LinesToStr([ + 'this.i=0;', + 'this.s="";', + 'this.c="";', + 'this.b=false;', + 'this.d=0;', + 'this.i2=3;', + 'this.s2="foo";', + 'this.c2="4";', + 'this.b2=true;', + 'this.d2=5.6;', + 'this.i3=0x707;', + 'this.i4= 4503599627370495;', + 'this.i5= -4503599627370496;', + 'this.i6= 0xfffffffffffff;', + 'this.i7=-0x10000000000000;' + ]), + ''); +end; + +procedure TTestModule.TestConstBaseTypes; +begin + StartProgram(false); + Add('const'); + Add(' i: longint = 3;'); + Add(' s: string = ''foo'';'); + Add(' c: char = ''4'';'); + Add(' b: boolean = true;'); + Add(' d: double = 5.6;'); + Add('begin'); + ConvertProgram; + CheckSource('TestVarBaseTypes', + LinesToStr([ + 'this.i=3;', + 'this.s="foo";', + 'this.c="4";', + 'this.b=true;', + 'this.d=5.6;' + ]), + ''); +end; + procedure TTestModule.TestEmptyProc; begin StartProgram(false); @@ -723,6 +884,199 @@ begin ])); end; +procedure TTestModule.TestAliasTypeRef; +begin + StartProgram(false); + Add('type'); + Add(' a=longint;'); + Add(' b=a;'); + Add('var'); + Add(' c: a;'); + Add(' d: b;'); + Add('begin'); + ConvertProgram; + CheckSource('TestAliasTypeRef', + LinesToStr([ // statements + 'this.c = 0;', + 'this.d = 0;' + ]), + LinesToStr([ // this.$main + '' + ])); +end; + +procedure TTestModule.TestIncDec; +begin + StartProgram(false); + Add('var'); + Add(' i: longint;'); + Add('begin'); + Add(' inc(i);'); + Add(' inc(i,2);'); + Add(' dec(i);'); + Add(' dec(i,3);'); + ConvertProgram; + CheckSource('TestIncDec', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'this.i+=1;', + 'this.i+=2;', + 'this.i-=1;', + 'this.i-=3;' + ])); +end; + +procedure TTestModule.TestAssignments; +begin + StartProgram(false); + Parser.Options:=Parser.Options+[po_cassignments]; + Add('var'); + Add(' i:longint;'); + Add('begin'); + Add(' i:=3;'); + Add(' i+=4;'); + Add(' i-=5;'); + Add(' i*=6;'); + ConvertProgram; + CheckSource('TestAssignments', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'this.i=3;', + 'this.i+=4;', + 'this.i-=5;', + 'this.i*=6;' + ])); +end; + +procedure TTestModule.TestPrgProcVar; +begin + StartProgram(false); + Add('procedure Proc1;'); + Add('type'); + Add(' t1=longint;'); + Add('var'); + Add(' v1:t1;'); + Add('begin'); + Add('end;'); + Add('begin'); + ConvertProgram; + CheckSource('TestPrgProcVar', + LinesToStr([ // statements + 'this.proc1 = function () {', + ' var v1=0;', + '};' + ]), + LinesToStr([ // this.$main + '' + ])); +end; + +procedure TTestModule.TestUnitProcVar; +begin + StartUnit(false); + Add('interface'); + Add(''); + Add('type t1=string; // unit scope'); + Add('procedure Proc1;'); + Add(''); + Add('implementation'); + Add(''); + Add('procedure Proc1;'); + Add('type t1=longint; // local proc scope'); + Add('var v1:t1; // using local t1'); + Add('begin'); + Add('end;'); + Add('var v2:t1; // using interface t1'); + ConvertUnit; + CheckSource('TestUnitProcVar', + LinesToStr([ // statements + 'var $impl = {', + '};', + 'this.proc1 = function () {', + ' var v1 = 0;', + '};', + 'this.$impl = $impl;', + '$impl.v2 = "";' + ]), + '' // this.$init + ); +end; + +procedure TTestModule.TestUnitImplVars; +begin + StartUnit(false); + Add('interface'); + Add('implementation'); + Add('var'); + Add(' v1:longint;'); + Add(' v2:longint = 3;'); + Add(' v3:string = ''abc'';'); + ConvertUnit; + CheckSource('TestUnitImplVar', + LinesToStr([ // statements + ' var $impl = {', + '};', + 'this.$impl = $impl;', + '$impl.v1 = 0;', + '$impl.v2 = 3;', + '$impl.v3 = "abc";' + ]), + ''); +end; + +procedure TTestModule.TestUnitImplConsts; +begin + StartUnit(false); + Add('interface'); + Add('implementation'); + Add('const'); + Add(' v1 = 3;'); + Add(' v2:longint = 4;'); + Add(' v3:string = ''abc'';'); + ConvertUnit; + CheckSource('TestUnitImplVar', + LinesToStr([ // statements + 'var $impl = {', + '};', + 'this.$impl = $impl;', + '$impl.v1 = 3;', + '$impl.v2 = 4;', + '$impl.v3 = "abc";' + ]), + ''); +end; + +procedure TTestModule.TestUnitImplRecord; +begin + StartUnit(false); + Add('interface'); + Add('implementation'); + Add('type'); + Add(' TMyRecord = record'); + Add(' i: longint;'); + Add(' end;'); + Add('var r: TMyRecord;'); + Add('initialization'); + Add(' r.i:=3;'); + ConvertUnit; + CheckSource('TestUnitImplVar', + LinesToStr([ // statements + 'var $impl = {', + '};', + 'this.$impl = $impl;', + '$impl.tmyrecord = function () {', + ' this.i = 0;', + '};', + '$impl.r = new $impl.tmyrecord();' + ]), + '$impl.r.i = 3;' + ); +end; + procedure TTestModule.TestProcTwoArgs; begin StartProgram(false); @@ -799,7 +1153,7 @@ begin CheckSource('TestVarRecord', LinesToStr([ // statements 'this.treca = function () {', - ' b = 0;', + ' this.b = 0;', '};', 'this.r = new this.treca();' ]), @@ -944,6 +1298,141 @@ begin Add(' i:=3'); Add(' end;'); ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'try {', + ' this.i = 0;', + ' this.i = (2 / this.i);', + '} finally {', + ' this.i = 3;', + '};' + ])); +end; + +procedure TTestModule.TestCaseOf; +begin + StartProgram(false); + Add('var i: longint;'); + Add('begin'); + Add(' case i of'); + Add(' 1: ;'); + Add(' 2: i:=3;'); + Add(' else'); + Add(' i:=4'); + Add(' end;'); + ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'var $tmp1 = this.i;', + 'if (($tmp1 == 1)) {} else if (($tmp1 == 2)) this.i = 3 else {', + ' this.i = 4;', + '};' + ])); +end; + +procedure TTestModule.TestCaseOf_UseSwitch; +begin + StartProgram(false); + Converter.UseSwitchStatement:=true; + Add('var i: longint;'); + Add('begin'); + Add(' case i of'); + Add(' 1: ;'); + Add(' 2: i:=3;'); + Add(' else'); + Add(' i:=4'); + Add(' end;'); + ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'switch (this.i) {', + 'case 1:', + ' break;', + 'case 2:', + ' this.i = 3;', + ' break;', + 'default:', + ' this.i = 4;', + '};' + ])); +end; + +procedure TTestModule.TestCaseOfNoElse; +begin + StartProgram(false); + Add('var i: longint;'); + Add('begin'); + Add(' case i of'); + Add(' 1: begin i:=2; i:=3; end;'); + Add(' end;'); + ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'var $tmp1 = this.i;', + 'if (($tmp1 == 1)) {', + ' this.i = 2;', + ' this.i = 3;', + '};' + ])); +end; + +procedure TTestModule.TestCaseOfNoElse_UseSwitch; +begin + StartProgram(false); + Converter.UseSwitchStatement:=true; + Add('var i: longint;'); + Add('begin'); + Add(' case i of'); + Add(' 1: begin i:=2; i:=3; end;'); + Add(' end;'); + ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'switch (this.i) {', + 'case 1:', + ' this.i = 2;', + ' this.i = 3;', + ' break;', + '};' + ])); +end; + +procedure TTestModule.TestCaseOfRange; +begin + StartProgram(false); + Add('var i: longint;'); + Add('begin'); + Add(' case i of'); + Add(' 1..3: i:=14;'); + Add(' 4,5: i:=16;'); + Add(' 6..7,9..10: ;'); + Add(' else ;'); + Add(' end;'); + ConvertProgram; + CheckSource('TestVarRecord', + LinesToStr([ // statements + 'this.i = 0;' + ]), + LinesToStr([ // this.$main + 'var $tmp1 = this.i;', + 'if ((($tmp1 >= 1) && ($tmp1 <= 3))) this.i = 14 else if ((($tmp1 == 4) || ($tmp1 == 5))) this.i = 16 else if (((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10)))) {} else {', + '};' + ])); end; Initialization