From 44c5fe99c91ca6d07d2eb619fde7180c244754f1 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 20 Mar 2017 23:29:53 +0000 Subject: [PATCH] * Patch from Mattias Gaertner: jswriter: fixed some empty lines pasresolver: procedure str, function str fppas2js: procedure str,function str write less empty blocks target platform browser and nodejs git-svn-id: trunk@35633 - --- packages/fcl-js/src/jswriter.pp | 108 ++++-- packages/fcl-passrc/src/pasresolver.pp | 278 ++++++++++++---- packages/fcl-passrc/src/pastree.pp | 2 +- packages/fcl-passrc/tests/tcresolver.pas | 98 +++++- packages/pastojs/src/fppas2js.pp | 364 +++++++++++++++------ packages/pastojs/tests/tcconverter.pp | 18 +- packages/pastojs/tests/tcmodules.pas | 192 +++++++---- packages/pastojs/tests/tcoptimizations.pas | 6 +- 8 files changed, 787 insertions(+), 279 deletions(-) diff --git a/packages/fcl-js/src/jswriter.pp b/packages/fcl-js/src/jswriter.pp index a799918377..36a1bf0b1d 100644 --- a/packages/fcl-js/src/jswriter.pp +++ b/packages/fcl-js/src/jswriter.pp @@ -127,7 +127,7 @@ Type // one per type of statement Procedure WriteValue(V : TJSValue); virtual; Procedure WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral); - Procedure WriteVariableStatement(el: TJSVariableStatement); + Procedure WriteVariableStatement(El: TJSVariableStatement); Procedure WriteEmptyBlockStatement(El: TJSEmptyBlockStatement); virtual; Procedure WriteEmptyStatement(El: TJSEmptyStatement);virtual; Procedure WriteLiteral(El: TJSLiteral);virtual; @@ -157,6 +157,8 @@ Type Procedure WriteFuncDef(FD: TJSFuncDef);virtual; Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual; Procedure WriteBinary(El: TJSBinary);virtual; + Function IsEmptyStatement(El: TJSElement): boolean; + Function HasLineEnding(El: TJSElement): boolean; Public Function EscapeString(const S: TJSString; Quote: TJSEscapeQuote = jseqDouble): TJSString; Constructor Create(AWriter : TTextWriter); @@ -584,6 +586,7 @@ procedure TJSWriter.WriteFuncDef(FD: TJSFuncDef); Var C : Boolean; I : Integer; + A: TJSElement; begin C:=(woCompact in Options); @@ -609,10 +612,11 @@ begin FSkipCurlyBrackets:=True; //writeln('TJSWriter.WriteFuncDef '+FD.Body.ClassName); WriteJS(FD.Body); - If (Assigned(FD.Body.A)) - and (not (FD.Body.A is TJSStatementList)) - and (not (FD.Body.A is TJSSourceElements)) - and (not (FD.Body.A is TJSEmptyBlockStatement)) + A:=FD.Body.A; + If (Assigned(A)) + and (not (A is TJSStatementList)) + and (not (A is TJSSourceElements)) + and (not (A is TJSEmptyBlockStatement)) then if C then Write('; ') @@ -861,7 +865,7 @@ begin Indent; if not C then writeln(''); end; - if Assigned(El.A) and (El.A.ClassType<>TJSEmptyBlockStatement) then + if not IsEmptyStatement(El.A) then begin WriteJS(El.A); LastEl:=El.A; @@ -926,6 +930,9 @@ Var S : AnsiString; AllowCompact, WithBrackets: Boolean; begin + {$IFDEF VerboseJSWriter} + System.writeln('TJSWriter.WriteBinary SkipRoundBrackets=',FSkipRoundBrackets); + {$ENDIF} WithBrackets:=not FSkipRoundBrackets; if WithBrackets then Write('('); @@ -945,6 +952,25 @@ begin Write(')'); end; +function TJSWriter.IsEmptyStatement(El: TJSElement): boolean; +begin + if (El=nil) then + exit(true); + if (El.ClassType=TJSEmptyStatement) and not (woEmptyStatementAsComment in Options) then + exit(true); + Result:=false; +end; + +function TJSWriter.HasLineEnding(El: TJSElement): boolean; +begin + if El<>nil then + begin + if (El.ClassType=TJSStatementList) or (El.ClassType=TJSSourceElements) then + exit(true); + end; + Result:=false; +end; + procedure TJSWriter.WriteConditionalExpression(El: TJSConditionalExpression); begin @@ -987,22 +1013,29 @@ end; procedure TJSWriter.WriteIfStatement(El: TJSIfStatement); +var + BTrueEmpty, C: Boolean; begin + C:=woCompact in Options; Write('if ('); FSkipRoundBrackets:=true; WriteJS(El.Cond); FSkipRoundBrackets:=false; Write(')'); - If Not (woCompact in Options) then + If Not C then Write(' '); - if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then - begin + BTrueEmpty:=IsEmptyStatement(El.BTrue); + if not BTrueEmpty then WriteJS(El.BTrue); - end; - if Assigned(El.BFalse) then + if not IsEmptyStatement(El.BFalse) then begin - if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then - Writeln('{}') + if BTrueEmpty then + begin + if C then + Write('{}') + else + Writeln('{}'); + end else Write(' '); Write('else '); @@ -1131,7 +1164,7 @@ begin Indent; WriteJS(EC.Body); Undent; - if ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then + if (EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement) then begin if C then begin @@ -1226,12 +1259,15 @@ Var begin C:=woCompact in Options; Write('try {'); - if Not C then writeln(''); - FSkipCurlyBrackets:=True; - Indent; - WriteJS(El.Block); - if Not C then writeln(''); - Undent; + if not IsEmptyStatement(El.Block) then + begin + if Not C then writeln(''); + FSkipCurlyBrackets:=True; + Indent; + WriteJS(El.Block); + if (Not C) and (not (El.Block is TJSStatementList)) then writeln(''); + Undent; + end; Write('}'); If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then begin @@ -1241,11 +1277,14 @@ begin Write(' {') else Writeln(' {'); - FSkipCurlyBrackets:=True; - Indent; - WriteJS(El.BCatch); - Undent; - if Not C then writeln(''); + if not IsEmptyStatement(El.BCatch) then + begin + FSkipCurlyBrackets:=True; + Indent; + WriteJS(El.BCatch); + Undent; + if (Not C) and (not (El.BCatch is TJSStatementList)) then writeln(''); + end; Write('}'); end; If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then @@ -1254,11 +1293,14 @@ begin Write(' finally {') else Writeln(' finally {'); - Indent; - FSkipCurlyBrackets:=True; - WriteJS(El.BFinally); - Undent; - if Not C then writeln(''); + if not IsEmptyStatement(El.BFinally) then + begin + Indent; + FSkipCurlyBrackets:=True; + WriteJS(El.BFinally); + Undent; + if (Not C) and (not (El.BFinally is TJSStatementList)) then writeln(''); + end; Write('}'); end; end; @@ -1267,7 +1309,7 @@ procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody); begin //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipCurlyBrackets,'true','false')); - if Assigned(El.A) and (not (El.A is TJSEmptyBlockStatement)) then + if not IsEmptyStatement(El.A) then WriteJS(El.A); end; @@ -1311,11 +1353,11 @@ begin WriteElements(El.Statements); end; -procedure TJSWriter.WriteVariableStatement(el: TJSVariableStatement); +procedure TJSWriter.WriteVariableStatement(El: TJSVariableStatement); begin Write('var '); - WriteJS(EL.A); + WriteJS(El.A); end; procedure TJSWriter.WriteJS(El: TJSElement); diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 18f37bfc57..508609bb2c 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -110,7 +110,7 @@ Works: - procedure break, procedure continue - built-in functions pred, succ for range type and enums - untyped parameters - +- built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string) ToDo: - fix slow lookup declaration proc in PParser @@ -159,9 +159,9 @@ Notes: @f(); @ operator applies to result of f f(); use f's result FuncVar:=Func; if mode=objfpc: incompatible - if mode=delphi: implicit addr of function f, not yet implemented - if f=g then : can implicit resolve each side once, at the moment: always implicit - p(f), f as var parameter: always implicit, thus incompatible + if mode=delphi: implicit addr of function f + if f=g then : can implicit resolve each side once + p(f), f as var parameter: can implicit } unit PasResolver; @@ -430,7 +430,9 @@ type bfLow, bfHigh, bfPred, - bfSucc + bfSucc, + bfStrProc, + bfStrFunc ); TResolverBuiltInProcs = set of TResolverBuiltInProc; const @@ -450,7 +452,9 @@ const 'Low', 'High', 'Pred', - 'Succ' + 'Succ', + 'Str', + 'Str' ); bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)]; @@ -1042,6 +1046,8 @@ type ErrorEl: TPasElement; RaiseOnError: boolean): boolean; procedure ConvertRangeToFirstValue(var ResolvedEl: TPasResolverResult); function IsCharLiteral(const Value: string): boolean; virtual; + function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr; + MinCount: integer; RaiseOnError: boolean): boolean; protected // built-in functions function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; @@ -1082,6 +1088,17 @@ type Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; procedure BI_PredSucc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc; {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; + function BI_Str_CheckParam(Param: TPasExpr; + const ParamResolved: TPasResolverResult; ArgNo: integer; + RaiseOnError: boolean): integer; + function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; + Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; + procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc; + Params: TParamsExpr); virtual; + function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc; + Expr: TPasExpr; RaiseOnError: boolean): integer; virtual; + procedure BI_StrFunc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc; + {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual; public constructor Create; destructor Destroy; override; @@ -4168,6 +4185,9 @@ begin ComputeElement(Expr,ExprResolved,[rcSkipTypeAlias]); if (rrfCanBeStatement in ExprResolved.Flags) then exit; + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDesc(ExprResolved)); + {$ENDIF} RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El); end; @@ -4215,9 +4235,9 @@ begin Primitive:=TPrimitiveExpr(El); case Primitive.Kind of pekIdent: ResolveNameExpr(El,Primitive.Value,Access); - pekNumber: exit; - pekString: exit; - pekNil,pekBoolConst: exit; + pekNumber: ; + pekString: ; + pekNil,pekBoolConst: ; else RaiseNotYetImplemented(20160922163451,El); end; @@ -4243,6 +4263,11 @@ begin end else RaiseNotYetImplemented(20170222184329,El); + + if El.format1<>nil then + ResolveExpr(El.format1,rraRead); + if El.format2<>nil then + ResolveExpr(El.format2,rraRead); end; procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr); @@ -6077,6 +6102,19 @@ begin end; end; +function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; + Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean; +begin + if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)2 then + begin + if RaiseOnError then + RaiseMsg(20170216152345,nWrongNumberOfParametersForCallTo, + sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[2]); + exit(cIncompatible); + end; + + Result:=cExact; +end; + +procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc; + Params: TParamsExpr); +var + P: TPasExprArray; +begin + if Proc=nil then ; + P:=Params.Params; + FinishParamExpressionAccess(P[0],rraRead); + FinishParamExpressionAccess(P[1],rraVarParam); +end; + +function TPasResolver.BI_StrFunc_OnGetCallCompatibility( + Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer; +var + Params: TParamsExpr; + Param: TPasExpr; + ParamResolved: TPasResolverResult; + i: Integer; +begin + if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then + exit(cIncompatible); + Params:=TParamsExpr(Expr); + + // param: string, boolean, integer, enum, class instance + for i:=0 to length(Params.Params)-1 do + begin + Param:=Params.Params[i]; + ComputeElement(Param,ParamResolved,[]); + Result:=BI_Str_CheckParam(Param,ParamResolved,i+1,RaiseOnError); + if Result=cIncompatible then + exit; + end; + + Result:=cExact; +end; + +procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc; + Params: TParamsExpr; out ResolvedEl: TPasResolverResult); +begin + if Params=nil then ; + SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,FBaseTypes[btString],[rrfReadable]); +end; + constructor TPasResolver.Create; begin inherited Create; @@ -7255,6 +7412,13 @@ begin if bfSucc in BaseProcs then AddBuiltInProc('Succ','function Succ(const ordinal): ordinal', @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,nil,bfSucc); + if bfStrProc in BaseProcs then + AddBuiltInProc('Str','procedure Str(const var; var String)', + @BI_StrProc_OnGetCallCompatibility,nil, + @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]); + if bfStrFunc in BaseProcs then + AddBuiltInProc('Str','function Str(const var): String', + @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,nil,bfStrFunc); end; function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index fc7f044eb7..b19ac43814 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -507,7 +507,7 @@ type ElType: TPasType; end; - { TPasEnumValue } + { TPasEnumValue - Parent is TPasEnumType } TPasEnumValue = class(TPasElement) public diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 45bb891a8a..b3a0a5d928 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -159,6 +159,9 @@ type Procedure TestIncDec; Procedure TestIncStringFail; Procedure TestVarExternal; + Procedure TestStr_BaseTypes; + Procedure TestStr_StringFail; + Procedure TestStr_CharFail; // strings Procedure TestString_SetLength; @@ -179,6 +182,7 @@ type Procedure TestEnumOrd; Procedure TestEnumPredSucc; Procedure TestEnum_CastIntegerToEnum; + Procedure TestEnum_Str; // operators Procedure TestPrgAssignment; @@ -560,7 +564,7 @@ begin +' Scanner at' +' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')' +' Line="'+Scanner.CurLine+'"'); - raise E; + Fail(E.Message); end; on E: EPasResolve do begin @@ -575,12 +579,12 @@ begin WriteSources(aFilename,aRow,aCol); writeln('ERROR: TTestResolver.ParseProgram PasResolver: '+E.ClassName+':'+E.Message +' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')'); - raise E; + Fail(E.Message); end; on E: Exception do begin writeln('ERROR: TTestResolver.ParseProgram Exception: '+E.ClassName+':'+E.Message); - raise E; + Fail(E.Message); end; end; TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine); @@ -607,7 +611,7 @@ begin +' Col='+IntToStr(Scanner.CurColumn) +' Line="'+Scanner.CurLine+'"' ); - raise E; + Fail(E.Message); end; on E: EPasResolve do begin @@ -617,12 +621,12 @@ begin +' Col='+IntToStr(Scanner.CurColumn) +' Line="'+Scanner.CurLine+'"' ); - raise E; + Fail(E.Message); end; on E: Exception do begin writeln('ERROR: TTestResolver.ParseUnit Exception: '+E.ClassName+':'+E.Message); - raise E; + Fail(E.Message); end; end; TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine); @@ -1196,7 +1200,7 @@ begin WriteSources(aFilename,aRow,aCol); s:='[TTestResolver.RaiseErrorAtSrc] '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+') Error: '+Msg; writeln('ERROR: ',s); - raise EAssertionFailedError.Create(s); + Fail(s); end; procedure TCustomTestResolver.RaiseErrorAtSrcMarker(Msg: string; aMarker: PSrcMarker); @@ -1219,7 +1223,7 @@ function TCustomTestResolver.AddModule(aFilename: string): TTestEnginePasResolve begin //writeln('TTestResolver.AddModule ',aFilename); if FindModuleWithFilename(aFilename)<>nil then - raise EAssertionFailedError.Create('TTestResolver.AddModule: file "'+aFilename+'" already exists'); + Fail('TTestResolver.AddModule: file "'+aFilename+'" already exists'); Result:=TTestEnginePasResolver.Create; Result.Filename:=aFilename; Result.AddObjFPCBuiltInIdentifiers; @@ -1406,7 +1410,7 @@ begin +' Line="'+CurEngine.Scanner.CurLine+'"' ); WriteSources(ErrFilename,ErrRow,ErrCol); - raise E; + Fail(E.Message); end; end; //writeln('TTestResolver.OnPasResolverFindUnit END ',CurUnitName); @@ -1415,7 +1419,7 @@ begin end; end; writeln('TTestResolver.OnPasResolverFindUnit missing unit "',aUnitName,'"'); - raise EAssertionFailedError.Create('can''t find unit "'+aUnitName+'"'); + Fail('can''t find unit "'+aUnitName+'"'); end; procedure TCustomTestResolver.OnFindReference(El: TPasElement; FindData: pointer); @@ -1445,7 +1449,7 @@ var s:='TTestResolver.OnCheckElementParent El='+GetTreeDesc(El)+' '+ ResolverEngine.GetElementSourcePosStr(El)+' '+Msg; writeln('ERROR: ',s); - raise EAssertionFailedError.Create(s); + Fail(s); end; begin @@ -1811,6 +1815,62 @@ begin ParseProgram; end; +procedure TTestResolver.TestStr_BaseTypes; +begin + StartProgram(false); + Add('var'); + Add(' b: boolean;'); + Add(' i: longint;'); + Add(' i64: int64;'); + Add(' s: single;'); + Add(' d: double;'); + Add(' aString: string;'); + Add('begin'); + Add(' Str(b,{#a_var}aString);'); + Add(' Str(b:1,aString);'); + Add(' Str(b:i,aString);'); + Add(' Str(i,aString);'); + Add(' Str(i:2,aString);'); + Add(' Str(i:i64,aString);'); + Add(' Str(i64,aString);'); + Add(' Str(i64:3,aString);'); + Add(' Str(i64:i,aString);'); + Add(' Str(s,aString);'); + Add(' Str(d,aString);'); + Add(' Str(d:4,aString);'); + Add(' Str(d:4:5,aString);'); + Add(' Str(d:4:i,aString);'); + Add(' aString:=Str(b);'); + Add(' aString:=Str(i:3);'); + Add(' aString:=Str(d:3:4);'); + Add(' aString:=Str(b,i,d);'); + ParseProgram; + CheckAccessMarkers; +end; + +procedure TTestResolver.TestStr_StringFail; +begin + StartProgram(false); + Add('var'); + Add(' aString: string;'); + Add('begin'); + Add(' Str(aString,aString);'); + CheckResolverException('Incompatible type arg no. 1: Got "String", expected "boolean, integer, enum value"', + nIncompatibleTypeArgNo); +end; + +procedure TTestResolver.TestStr_CharFail; +begin + StartProgram(false); + Add('var'); + Add(' c: char;'); + Add(' aString: string;'); + Add('begin'); + Add(' Str(c,aString);'); + CheckResolverException('Incompatible type arg no. 1: Got "Char", expected "boolean, integer, enum value"', + nIncompatibleTypeArgNo); +end; + procedure TTestResolver.TestString_SetLength; begin StartProgram(false); @@ -2127,6 +2187,22 @@ begin CheckAccessMarkers; end; +procedure TTestResolver.TestEnum_Str; +begin + StartProgram(false); + Add('type'); + Add(' TFlag = (red, green, blue);'); + Add('var'); + Add(' f: TFlag;'); + Add(' i: longint;'); + Add(' aString: string;'); + Add('begin'); + Add(' aString:=str(f);'); + Add(' aString:=str(f:3);'); + Add(' str(f,aString);'); + ParseProgram; +end; + procedure TTestResolver.TestPrgAssignment; var El: TPasElement; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 52465d1649..214a732e09 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -153,8 +153,7 @@ Works: - use 0o for octal literals ToDos: -- function str, procedure str -- try raise E1 except on E: E2 end; +- class external Not in Version 1.0: - write, writeln @@ -245,8 +244,8 @@ resourcestring sMissingExternalName = 'Missing external name'; const - DefaultFuncNameArray_SetLength = 'arraySetLength'; // rtl.arraySetLength DefaultFuncNameArray_NewMultiDim = 'arrayNewMultiDim'; // rtl.arrayNewMultiDim + DefaultFuncNameArray_SetLength = 'arraySetLength'; // rtl.arraySetLength DefaultFuncNameAs = 'as'; // rtl.as DefaultFuncNameCreateClass = 'createClass'; // rtl.createClass DefaultFuncNameFreeClassInstance = '$destroy'; @@ -268,6 +267,8 @@ const DefaultFuncNameSet_Reference = 'refSet'; // rtl.refSet DefaultFuncNameSet_SymDiffSet = 'symDiffSet'; // rtl.symDiffSet >< (symmetrical difference) DefaultFuncNameSet_Union = 'unionSet'; // rtl.unionSet + + DefaultFuncNameSpaceLeft = 'spaceLeft'; // rtl.spaceLeft + DefaultVarNameExceptObject = '$e'; DefaultVarNameImplementation = '$impl'; DefaultVarNameLoopEnd = '$loopend'; DefaultVarNameModules = 'pas'; @@ -544,9 +545,20 @@ type TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object; + TPasToJsPlatform = ( + PlatformBrowser, + PlatformNodeJS + ); + TPasToJsPlatforms = set of TPasToJsPlatform; +const + PasToJsPlatformNames: array[TPasToJsPlatform] of string = ( + 'Browser', + 'NodeJS' + ); +type TPasToJsProcessor = ( - pECMAScript5, - pECMAScript6 + ProcessorECMAScript5, + ProcessorECMAScript6 ); TPasToJsProcessors = set of TPasToJsProcessor; const @@ -614,9 +626,12 @@ type FFuncNameSet_Reference: String; FFuncNameSet_SymDiffSet: String; FFuncNameSet_Union: String; + FFuncNameSpaceLeft: String; FOnIsElementUsed: TPas2JSIsElementUsedEvent; FOptions: TPasToJsConverterOptions; + FTargetPlatform: TPasToJsPlatform; FTargetProcessor: TPasToJsProcessor; + FVarNameExceptObject: String; FVarNameImplementation: String; FVarNameLoopEnd: String; FVarNameModules: String; @@ -635,7 +650,6 @@ type DataClass: TPas2JsElementDataClass): TPas2JsElementData; procedure AddElementData(Data: TPas2JsElementData); Procedure AddToSourceElements(Src: TJSSourceElements; El: TJSElement); - procedure SetTargetProcessor(const AValue: TPasToJsProcessor); procedure SetUseEnumNumbers(const AValue: boolean); procedure SetUseLowerCase(const AValue: boolean); procedure SetUseSwitchStatement(const AValue: boolean); @@ -658,7 +672,6 @@ type Function TransformVariableName(El: TPasElement; AContext : TConvertContext) : String; virtual; Function TransformModuleName(El: TPasModule; AContext : TConvertContext) : String; virtual; Function IsPreservedWord(aName: string): boolean; virtual; - Function GetExceptionObjectName(AContext: TConvertContext) : string; // Never create an element manually, always use the below functions Function IsElementUsed(El: TPasElement): boolean; virtual; Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual; @@ -702,9 +715,10 @@ type RecordExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual; Function CreateCallback(El: TPasElement; ResolvedEl: TPasResolverResult; AContext: TConvertContext): TJSElement; virtual; + Function CreateAssignStatement(LeftEl: TPasElement; AssignContext: TAssignContext): TJSElement; virtual; // Statements - Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement; virtual; - Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement; virtual; + Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; + Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement; virtual; Function ConvertAssignStatement(El: TPasImplAssign; AContext: TConvertContext): TJSElement; virtual; Function ConvertRaiseStatement(El: TPasImplRaise; AContext: TConvertContext ): TJSElement; virtual; @@ -741,6 +755,9 @@ type Function ConvertBuiltInHigh(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBuiltInPred(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBuiltInSucc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; + Function ConvertBuiltInStrProc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; + Function ConvertBuiltInStrFunc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; + Function ConvertBuiltInStrParam(El: TPasExpr; AContext: TConvertContext; IsFirst: boolean): TJSElement; virtual; Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual; Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual; @@ -776,7 +793,8 @@ type Function ConvertPasElement(El : TPasElement; Resolver: TPasResolver) : TJSElement; // options Property Options: TPasToJsConverterOptions read FOptions write FOptions; - Property TargetProcessor: TPasToJsProcessor read FTargetProcessor write SetTargetProcessor; + Property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform; + Property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor; Property UseLowerCase: boolean read GetUseLowerCase write SetUseLowerCase default true; Property UseSwitchStatement: boolean read GetUseSwitchStatement write SetUseSwitchStatement;// default false, because slower than "if" in many engines Property UseEnumNumbers: boolean read GetUseEnumNumbers write SetUseEnumNumbers; // default false @@ -806,6 +824,8 @@ type Property FuncNameSet_Reference: String read FFuncNameSet_Reference write FFuncNameSet_Reference; // rtl.refSet Property FuncNameSet_SymDiffSet: String read FFuncNameSet_SymDiffSet write FFuncNameSet_SymDiffSet; // rtl.symDiffSet (symmetrical difference >< Property FuncNameSet_Union: String read FFuncNameSet_Union write FFuncNameSet_Union; // rtl.unionSet + + Property FuncNameSpaceLeft: String read FFuncNameSpaceLeft write FFuncNameSpaceLeft; + Property VarNameExceptObject: String read FVarNameExceptObject write FVarNameExceptObject; Property VarNameImplementation: String read FVarNameImplementation write FVarNameImplementation;// empty to not use, default '$impl' Property VarNameLoopEnd: String read FVarNameLoopEnd write FVarNameLoopEnd; Property VarNameModules: String read FVarNameModules write FVarNameModules; @@ -813,9 +833,6 @@ type Property VarNameWith: String read FVarNameWith write FVarNameWith; end; -var - DefaultJSExceptionObject: string = '$e'; - function CodePointToJSString(u: cardinal): TJSString; function PosLast(c: char; const s: string): integer; @@ -2202,11 +2219,11 @@ begin S:=copy(El.Value,2,length(El.Value)); case El.Value[1] of '$': S:='0x'+S; - '&': if TargetProcessor=pECMAScript5 then + '&': if TargetProcessor=ProcessorECMAScript5 then S:='0'+S else S:='0o'+S; - '%': if TargetProcessor=pECMAScript5 then + '%': if TargetProcessor=ProcessorECMAScript5 then S:='' else S:='0b'+S; @@ -2948,6 +2965,8 @@ begin bfHigh: Result:=ConvertBuiltInHigh(El,AContext); bfPred: Result:=ConvertBuiltInPred(El,AContext); bfSucc: Result:=ConvertBuiltInSucc(El,AContext); + bfStrProc: Result:=ConvertBuiltInStrProc(El,AContext); + bfStrFunc: Result:=ConvertBuiltInStrFunc(El,AContext); else RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]); end; @@ -3142,7 +3161,7 @@ var ResolvedParam0: TPasResolverResult; ArrayType: TPasArrayType; Call: TJSCallExpression; - ValInit, Arg, LHS: TJSElement; + ValInit, Arg: TJSElement; AssignSt: TJSSimpleAssignStatement; AssignContext: TAssignContext; ElType: TPasType; @@ -3163,7 +3182,6 @@ begin {$IFDEF VerbosePasResolver} writeln('TPasToJSConverter.ConvertBuiltInSetLength array'); {$ENDIF} - LHS:=nil; AssignContext:=TAssignContext.Create(El,nil,AContext); try AContext.Resolver.ComputeElement(El.Value,AssignContext.LeftResolved,[rcNoImplicitProc]); @@ -3187,26 +3205,8 @@ begin Call.Args.Elements.AddElement.Expr:=ValInit; // create left side: array = - LHS:=ConvertElement(Param0,AssignContext); - if AssignContext.Call<>nil then - begin - // array has a setter -> right side was already added as parameter - if AssignContext.RightSide<>nil then - RaiseInconsistency(20170207215447); - Result:=LHS; - end - else - begin - AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); - AssignSt.LHS:=LHS; - AssignSt.Expr:=AssignContext.RightSide; - AssignContext.RightSide:=nil; - Result:=AssignSt; - end; - + Result:=CreateAssignStatement(Param0,AssignContext); finally - if Result=nil then - LHS.Free; AssignContext.RightSide.Free; AssignContext.Free; end; @@ -3241,12 +3241,9 @@ var Call: TJSCallExpression; Param0: TPasExpr; AssignContext: TAssignContext; - AssignSt: TJSSimpleAssignStatement; - LHS: TJSElement; FunName: String; begin Result:=nil; - LHS:=nil; Param0:=El.Params[0]; AssignContext:=TAssignContext.Create(El,nil,AContext); try @@ -3264,26 +3261,8 @@ begin Call.Args.Elements.AddElement.Expr:=ConvertElement(Param0,AContext); Call.Args.Elements.AddElement.Expr:=ConvertElement(El.Params[1],AContext); - // create left side: aSet = - LHS:=ConvertElement(Param0,AssignContext); - if AssignContext.Call<>nil then - begin - // set has a setter -> right side was already added as parameter - if AssignContext.RightSide<>nil then - RaiseInconsistency(20170301145100); - Result:=LHS; - end - else - begin - AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El)); - AssignSt.LHS:=LHS; - AssignSt.Expr:=AssignContext.RightSide; - AssignContext.RightSide:=nil; - Result:=AssignSt; - end; + Result:=CreateAssignStatement(Param0,AssignContext); finally - if Result=nil then - LHS.Free; AssignContext.RightSide.Free; AssignContext.Free; end; @@ -3617,7 +3596,7 @@ end; function TPasToJSConverter.ConvertBuiltInSucc(El: TParamsExpr; AContext: TConvertContext): TJSElement; -// pred(enumvalue) -> enumvalue-1 +// succ(enumvalue) -> enumvalue+1 var ResolvedEl: TPasResolverResult; Param: TPasExpr; @@ -3642,6 +3621,163 @@ begin DoError(20170210120626,nExpectedXButFoundY,sExpectedXButFoundY,['enum',GetResolverResultDescription(ResolvedEl)],Param); end; +function TPasToJSConverter.ConvertBuiltInStrProc(El: TParamsExpr; + AContext: TConvertContext): TJSElement; +// convert 'str(value,aString)' to 'aString = ' +// for the conversion see ConvertBuiltInStrFunc +var + AssignContext: TAssignContext; + StrVar: TPasExpr; +begin + Result:=nil; + AssignContext:=TAssignContext.Create(El,nil,AContext); + try + StrVar:=El.Params[1]; + AContext.Resolver.ComputeElement(StrVar,AssignContext.LeftResolved,[rcNoImplicitProc]); + + // create right side + AssignContext.RightSide:=ConvertBuiltInStrParam(El.Params[0],AContext,true); + SetResolverValueExpr(AssignContext.RightResolved,btString, + AContext.Resolver.BaseType[btString],El,[rrfReadable]); + + // create 'StrVar = rightside' + Result:=CreateAssignStatement(StrVar,AssignContext); + finally + AssignContext.RightSide.Free; + AssignContext.Free; + end; +end; + +function TPasToJSConverter.ConvertBuiltInStrFunc(El: TParamsExpr; + AContext: TConvertContext): TJSElement; +// convert 'str(boolean)' to '""+boolean' +// convert 'str(integer)' to '""+integer' +// convert 'str(float)' to '""+float' +// convert 'str(float:width)' to rtl.spaceLeft('""+float,width)' +// convert 'str(float:width:precision)' to 'rtl.spaceLeft(float.toFixed(precision),width)' +var + i: Integer; + Param: TPasExpr; + Sum, Add: TJSElement; + AddEl: TJSAdditiveExpressionPlus; +begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertBuiltInStrFunc Count=',length(El.Params)); + {$ENDIF} + Result:=nil; + Sum:=nil; + Add:=nil; + try + for i:=0 to length(El.Params)-1 do + begin + Param:=El.Params[i]; + Add:=ConvertBuiltInStrParam(Param,AContext,i=0); + if Sum=nil then + Sum:=Add + else + begin + AddEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param)); + AddEl.A:=Sum; + AddEl.B:=Add; + Sum:=AddEl; + end; + Add:=nil; + end; + Result:=Sum; + finally + Add.Free; + if Result=nil then + Sum.Free; + end; +end; + +function TPasToJSConverter.ConvertBuiltInStrParam(El: TPasExpr; + AContext: TConvertContext; IsFirst: boolean): TJSElement; +var + ResolvedEl: TPasResolverResult; + NeedStrLit: Boolean; + Add: TJSElement; + Call: TJSCallExpression; + PlusEl: TJSAdditiveExpressionPlus; + Bracket: TJSBracketMemberExpression; + procedure PrependStrLit; + begin + PlusEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El)); + PlusEl.A:=CreateLiteralString(El,''); + PlusEl.B:=Add; + Add:=PlusEl; + end; + +begin + Result:=nil; + AContext.Resolver.ComputeElement(El,ResolvedEl,[]); + Add:=nil; + Call:=nil; + Bracket:=nil; + try + NeedStrLit:=false; + if ResolvedEl.BaseType in (btAllBooleans+btAllInteger) then + begin + NeedStrLit:=true; + Add:=ConvertElement(El,AContext); + end + else if ResolvedEl.BaseType in btAllFloats then + begin + NeedStrLit:=true; + Add:=ConvertElement(El,AContext); + if El.format2<>nil then + begin + // precision -> rtl El.toFixed(precision); + NeedStrLit:=false; + Call:=CreateCallExpression(El); + Call.Expr:=CreateDotExpression(El,Add,CreateBuiltInIdentifierExpr('toFixed')); + Call.Args.Elements.AddElement.Expr:=ConvertElement(El.format2,AContext); + Add:=Call; + Call:=nil; + end; + end + else if ResolvedEl.BaseType=btContext then + begin + if ResolvedEl.TypeEl.ClassType=TPasEnumType then + begin + // create enumtype[enumvalue] + Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El)); + Bracket.MExpr:=CreateReferencePathExpr(TPasEnumType(ResolvedEl.TypeEl),AContext); + Bracket.Name:=ConvertElement(El,AContext); + Add:=Bracket; + Bracket:=nil; + end + else + RaiseNotSupported(El,AContext,20170320123827); + end + else + RaiseNotSupported(El,AContext,20170320093001); + + if El.format1<>nil then + begin + // width -> leading spaces + if NeedStrLit then + PrependStrLit; + // create 'rtl.spaceLeft(add,width)' + Call:=CreateCallExpression(El); + Call.Expr:=CreateMemberExpression([VarNameRTL,FuncNameSpaceLeft]); + Call.Args.Elements.AddElement.Expr:=Add; + Add:=nil; + Call.Args.Elements.AddElement.Expr:=ConvertElement(El.format1,AContext); + Add:=Call; + Call:=nil; + end + else if IsFirst and NeedStrLit then + PrependStrLit; + Result:=Add; + finally + Call.Free; + Bracket.Free; + if Result=nil then + Add.Free; + end; +end; + function TPasToJSConverter.ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; @@ -3884,7 +4020,7 @@ begin if El.ElseBranch<>nil then begin JSCaseEl:=SwitchEl.Cases.AddCase; - JSCaseEl.Body:=ConvertImplBlockElements(El.ElseBranch,AContext); + JSCaseEl.Body:=ConvertImplBlockElements(El.ElseBranch,AContext,false); SwitchEl.TheDefault:=JSCaseEl; end; ok:=true; @@ -4465,12 +4601,6 @@ begin until false; end; -procedure TPasToJSConverter.SetTargetProcessor(const AValue: TPasToJsProcessor); -begin - if FTargetProcessor=AValue then Exit; - FTargetProcessor:=AValue; -end; - constructor TPasToJSConverter.Create; begin FOptions:=[coLowerCase]; @@ -4497,6 +4627,8 @@ begin FFuncNameSet_Reference:=DefaultFuncNameSet_Reference; FFuncNameSet_SymDiffSet:=DefaultFuncNameSet_SymDiffSet; FFuncNameSet_Union:=DefaultFuncNameSet_Union; + FFuncNameSpaceLeft:=DefaultFuncNameSpaceLeft; + FVarNameExceptObject:=DefaultVarNameExceptObject; FVarNameImplementation:=DefaultVarNameImplementation; FVarNameLoopEnd:=DefaultVarNameLoopEnd; FVarNameModules:=DefaultVarNameModules; @@ -4638,14 +4770,14 @@ begin end; function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock; - AContext: TConvertContext): TJSElement; + AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; begin - Result:=ConvertImplBlockElements(El,AContext); + Result:=ConvertImplBlockElements(El,AContext,NilIfEmpty); end; function TPasToJSConverter.ConvertImplBlockElements(El: TPasImplBlock; - AContext: TConvertContext): TJSElement; + AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; var First, Last: TJSStatementList; @@ -4655,7 +4787,12 @@ var begin if Not (Assigned(El.Elements) and (El.Elements.Count>0)) then - Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El)) + begin + if NilIfEmpty then + Result:=nil + else + Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El)); + end else begin First:=nil; @@ -4708,7 +4845,7 @@ begin Body:=FDS.AFunction.Body; FuncContext:=TFunctionContext.Create(El,Body,AContext); FuncContext.This:=AContext.GetThis; - Body.A:=ConvertImplBlockElements(El,FuncContext); + Body.A:=ConvertImplBlockElements(El,FuncContext,false); end; ok:=true; finally @@ -4754,15 +4891,15 @@ begin if El.FinallyExcept is TPasImplTryFinally then begin T:=TJSTryFinallyStatement(CreateElement(TJSTryFinallyStatement,El)); - T.Block:=ConvertImplBlockElements(El,AContext); - T.BFinally:=ConvertImplBlockElements(El.FinallyExcept,AContext); + T.Block:=ConvertImplBlockElements(El,AContext,true); + T.BFinally:=ConvertImplBlockElements(El.FinallyExcept,AContext,true); end else begin T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El)); - T.Block:=ConvertImplBlockElements(El,AContext); + T.Block:=ConvertImplBlockElements(El,AContext,true); if NeedExceptObject then - T.Ident:=TJSString(GetExceptionObjectName(AContext)); + T.Ident:=TJSString(VarNameExceptObject); //T.BCatch:=ConvertElement(El.FinallyExcept,AContext); ExceptBlock:=El.FinallyExcept; if (ExceptBlock.Elements.Count>0) @@ -4780,13 +4917,20 @@ begin Last:=IfSt; end; if El.ElseBranch<>nil then - Last.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext); + Last.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true) + else + begin + // default else: throw exceptobject + Last.BFalse:=TJSThrowStatement(CreateElement(TJSThrowStatement,El)); + TJSThrowStatement(Last.BFalse).A:= + CreateBuiltInIdentifierExpr(VarNameExceptObject); + end; end else begin if El.ElseBranch<>nil then RaiseNotSupported(El.ElseBranch,AContext,20170205003014); - T.BCatch:=ConvertImplBlockElements(ExceptBlock,AContext); + T.BCatch:=ConvertImplBlockElements(ExceptBlock,AContext,true); end; end; Result:=T; @@ -4925,7 +5069,7 @@ 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); + LastIfSt.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true); end else RaiseNotSupported(SubEl,AContext,20161128113055); @@ -5170,6 +5314,34 @@ begin end; end; +function TPasToJSConverter.CreateAssignStatement(LeftEl: TPasElement; + AssignContext: TAssignContext): TJSElement; +var + LHS: TJSElement; + AssignSt: TJSSimpleAssignStatement; +begin + Result:=nil; + LHS:=ConvertElement(LeftEl,AssignContext); + if AssignContext.Call<>nil then + begin + // has a setter -> right side was already added as parameter + if AssignContext.RightSide<>nil then + begin + LHS.Free; + RaiseInconsistency(20170207215447); + end; + Result:=LHS; + end + else + begin + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,AssignContext.PasElement)); + AssignSt.LHS:=LHS; + AssignSt.Expr:=AssignContext.RightSide; + AssignContext.RightSide:=nil; + Result:=AssignSt; + end; +end; + function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext): TJSElement; @@ -5182,7 +5354,7 @@ begin else if (El.ClassType=TPasImplRepeatUntil) then Result:=ConvertRepeatStatement(TPasImplRepeatUntil(El),AContext) else if (El.ClassType=TPasImplBeginBlock) then - Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext) + Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,true) else if (El.ClassType=TInitializationSection) then Result:=ConvertInitializationSection(TInitializationSection(El),AContext) else if (El.ClassType=TFinalizationSection) then @@ -5295,7 +5467,7 @@ begin if El.ExceptObject<>Nil then E:=ConvertElement(El.ExceptObject,AContext) else - E:=CreateBuiltInIdentifierExpr(GetExceptionObjectName(AContext)); + E:=CreateBuiltInIdentifierExpr(VarNameExceptObject); T:=TJSThrowStatement(CreateElement(TJSThrowStatement,El)); T.A:=E; Result:=T; @@ -5430,9 +5602,7 @@ begin try C:=ConvertElement(El.ConditionExpr,AContext); if Assigned(El.IfBranch) then - BThen:=ConvertElement(El.IfBranch,AContext) - else - BThen:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El)); + BThen:=ConvertElement(El.IfBranch,AContext); if Assigned(El.ElseBranch) then BElse:=ConvertElement(El.ElseBranch,AContext); ok:=true; @@ -5502,7 +5672,7 @@ begin C:=ConvertElement(EL.ConditionExpr,AContext); N:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,EL.ConditionExpr)); N.A:=C; - B:=ConvertImplBlockElements(El,AContext); + B:=ConvertImplBlockElements(El,AContext,false); ok:=true; finally if not ok then @@ -5734,11 +5904,6 @@ begin begin B:=ConvertElement(El.Body,AContext); AddToStatementList(FirstSt,LastSt,B,El.Body); - end - else - begin - B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El)); - AddToStatementList(FirstSt,LastSt,B,El); end; Result:=FirstSt; finally @@ -5779,15 +5944,6 @@ begin end; end; -function TPasToJSConverter.GetExceptionObjectName(AContext: TConvertContext - ): string; -begin - if AContext=nil then ; - Result:=DefaultJSExceptionObject; // use the same as the FPC RTL - if UseLowerCase then - Result:=lowercase(Result); -end; - function TPasToJSConverter.IsElementUsed(El: TPasElement): boolean; begin if Assigned(OnIsElementUsed) then @@ -6789,7 +6945,7 @@ begin // create "T.isPrototypeOf(exceptObject)" Call:=CreateCallExpression(El); Call.Expr:=DotExpr; - Call.Args.Elements.AddElement.Expr:=CreateBuiltInIdentifierExpr(GetExceptionObjectName(AContext)); + Call.Args.Elements.AddElement.Expr:=CreateBuiltInIdentifierExpr(VarNameExceptObject); IfSt.Cond:=Call; if El.VarEl<>nil then @@ -6803,11 +6959,11 @@ begin VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El)); V.A:=VarDecl; VarDecl.Name:=TransformVariableName(El,El.VariableName,AContext); - VarDecl.Init:=CreateBuiltInIdentifierExpr(GetExceptionObjectName(AContext)); + VarDecl.Init:=CreateBuiltInIdentifierExpr(VarNameExceptObject); // add statements AddToStatementList(ListFirst,ListLast,ConvertElement(El.Body,AContext),El); end - else + else if El.Body<>nil then // add statements IfSt.BTrue:=ConvertElement(El.Body,AContext); @@ -7360,7 +7516,6 @@ begin Result:=true; if aName=VarNameModules then exit; if aName=VarNameRTL then exit; - if aName=GetExceptionObjectName(nil) then exit; l:=low(JSReservedWords); r:=high(JSReservedWords); @@ -7387,7 +7542,10 @@ begin aContext:=TRootContext.Create(El,nil,nil); try aContext.Resolver:=Resolver; - Result:=ConvertElement(El,aContext); + if (El.ClassType=TPasImplBeginBlock) then + Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,false) + else + Result:=ConvertElement(El,aContext); finally FreeAndNil(aContext); end; diff --git a/packages/pastojs/tests/tcconverter.pp b/packages/pastojs/tests/tcconverter.pp index eb185585db..15058c5247 100644 --- a/packages/pastojs/tests/tcconverter.pp +++ b/packages/pastojs/tests/tcconverter.pp @@ -187,8 +187,8 @@ begin R:=TPasImplIfElse.Create('',Nil); R.ConditionExpr:=CreateCondition; E:=TJSIfStatement(Convert(R,TJSIfStatement)); - AssertEquals('If branch is empty block statement',TJSEmptyBlockStatement,E.btrue.ClassType); - AssertNull('No else branch',E.bfalse); + AssertNull('If branch is empty',E.BTrue); + AssertNull('No else branch',E.BFalse); AssertIdentifier('Left hand side OK',E.Cond,'a'); end; @@ -668,7 +668,7 @@ begin // Convert El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement)); // check "catch(exceptobject)" - AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident)); + AssertEquals('Correct exception object name',lowercase(DefaultVarNameExceptObject),String(El.Ident)); // check "if" I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch)); // check if condition "exception.isPrototypeOf(exceptobject)" @@ -679,14 +679,14 @@ begin AssertNotNull('args of exception.isPrototypeOf(exceptobject)',IC.Args); AssertEquals('args of exception.isPrototypeOf(exceptobject)',1,IC.Args.Elements.Count); ExObj:=IC.Args.Elements.Elements[0].Expr; - Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,lowercase(DefaultJSExceptionObject)); + Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,lowercase(DefaultVarNameExceptObject)); // check statement "var e = exceptobject;" L:=AssertListStatement('On block is always a list',I.BTrue); writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName); VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A)); V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A)); AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name); - Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject)); + Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultVarNameExceptObject)); // check "b = c;" AssertAssignStatement('Original assignment in second statement',L.B,'b','c'); end; @@ -727,7 +727,7 @@ begin // Convert El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement)); // check "catch(exceptobject)" - AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident)); + AssertEquals('Correct exception object name',lowercase(DefaultVarNameExceptObject),String(El.Ident)); // check "if" I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch)); // check if condition "exception.isPrototypeOf(exceptobject)" @@ -738,16 +738,16 @@ begin AssertNotNull('args of exception.isPrototypeOf(ExceptObject)',IC.Args); AssertEquals('args of exception.isPrototypeOf(ExceptObject)',1,IC.Args.Elements.Count); ExObj:=IC.Args.Elements.Elements[0].Expr; - Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,lowercase(DefaultJSExceptionObject)); + Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,lowercase(DefaultVarNameExceptObject)); // check statement "var e = exceptobject;" L:=AssertListStatement('On block is always a list',I.BTrue); writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName); VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A)); V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A)); AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name); - Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultJSExceptionObject)); + Assertidentifier('Variable init is exception object',V.Init,lowercase(DefaultVarNameExceptObject)); R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B)); - Assertidentifier('R expression is original exception ',R.A,lowercase(DefaultJSExceptionObject)); + Assertidentifier('R expression is original exception ',R.A,lowercase(DefaultVarNameExceptObject)); end; Procedure TTestStatementConverter.TestVariableStatement; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index a204c62cc2..e231799e8c 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -164,6 +164,7 @@ type Procedure TestString_Compare; Procedure TestString_SetLength; Procedure TestString_CharAt; + Procedure TestStr; // alias types Procedure TestAliasTypeRef; @@ -211,6 +212,7 @@ type Procedure TestSet_Property; // statements + Procedure TestNestBegin; Procedure TestIncDec; Procedure TestAssignments; Procedure TestArithmeticOperators1; @@ -458,7 +460,7 @@ begin +' Col='+IntToStr(CurEngine.Scanner.CurColumn) +' Line="'+CurEngine.Scanner.CurLine+'"' ); - raise E; + Fail(E.Message); end; end; //writeln('TTestModule.OnPasResolverFindUnit END ',CurUnitName); @@ -467,7 +469,7 @@ begin end; end; writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"'); - raise Exception.Create('can''t find unit "'+aUnitName+'"'); + Fail('can''t find unit "'+aUnitName+'"'); end; procedure TCustomTestModule.SetUp; @@ -547,7 +549,7 @@ begin +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')' +' Line="'+Scanner.CurLine+'"' ); - raise E; + Fail(E.Message); end; on E: EPasResolve do begin @@ -556,12 +558,12 @@ begin writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message +' '+E.PasElement.SourceFilename +'('+IntToStr(Row)+','+IntToStr(Col)+')'); - raise E; + Fail(E.Message); end; on E: Exception do begin writeln('ERROR: TTestModule.ParseModule Exception: '+E.ClassName+':'+E.Message); - raise E; + Fail(E.Message); end; end; AssertNotNull('Module resulted in Module',FModule); @@ -609,7 +611,7 @@ function TCustomTestModule.AddModule(aFilename: string begin //writeln('TTestModuleConverter.AddModule ',aFilename); if FindModuleWithFilename(aFilename)<>nil then - raise Exception.Create('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists'); + Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists'); Result:=TTestEnginePasResolver.Create; Result.Filename:=aFilename; Result.AddObjFPCBuiltInIdentifiers([btChar,btString,btLongint,btInt64,btBoolean,btDouble]); @@ -695,14 +697,14 @@ begin writeln('ERROR: TTestModule.ConvertModule Scanner: '+E.ClassName+':'+E.Message +' '+Scanner.CurFilename +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')'); - raise E; + Fail(E.Message); end; on E: EParserError do begin WriteSource(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn); writeln('ERROR: TTestModule.ConvertModule Parser: '+E.ClassName+':'+E.Message +' '+Scanner.CurFilename +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')'); - raise E; + Fail(E.Message); end; on E: EPasResolve do begin @@ -711,7 +713,7 @@ begin writeln('ERROR: TTestModule.ConvertModule PasResolver: '+E.ClassName+':'+E.Message +' '+E.PasElement.SourceFilename +'('+IntToStr(Row)+','+IntToStr(Col)+')'); - raise E; + Fail(E.Message); end; on E: EPas2JS do begin @@ -725,12 +727,12 @@ begin end else writeln('ERROR: TTestModule.ConvertModule Exception: '+E.ClassName+':'+E.Message); - raise E; + Fail(E.Message); end; on E: Exception do begin writeln('ERROR: TTestModule.ConvertModule Exception: '+E.ClassName+':'+E.Message); - raise E; + Fail(E.Message); end; end; FJSSource:=TStringList.Create; @@ -1526,8 +1528,7 @@ begin ' this.FuncA(Bar);', '};', 'this.FuncA = function (Bar) {', - ' if (Bar == 3) {', - ' };', + ' if (Bar == 3);', '};' ]), LinesToStr([ @@ -1563,8 +1564,7 @@ begin ' FuncB(i);', ' };', ' function FuncB(i) {', - ' if (i == 3) {', - ' };', + ' if (i == 3);', ' };', ' FuncC(4);', '};' @@ -1628,12 +1628,9 @@ begin 'this.i = 0;' ]), LinesToStr([ - 'if (this.Func2()) {', - '};', - 'if (this.i == this.Func1()) {', - '};', - 'if (this.i == this.Func1()) {', - '};' + 'if (this.Func2());', + 'if (this.i == this.Func1());', + 'if (this.i == this.Func1());' ])); end; @@ -2230,6 +2227,7 @@ begin Add('var'); Add(' e: TMyEnum;'); Add(' i: longint;'); + Add(' s: string;'); Add('begin'); Add(' i:=ord(red);'); Add(' i:=ord(green);'); @@ -2244,6 +2242,9 @@ begin Add(' e:=succ(e);'); Add(' e:=tmyenum(1);'); Add(' e:=tmyenum(i);'); + Add(' s:=str(e);'); + Add(' str(e,s)'); + Add(' s:=str(e:3);'); ConvertProgram; CheckSource('TestEnumNumber', LinesToStr([ // statements @@ -2254,7 +2255,8 @@ begin ' Green:1', ' };', 'this.e = 0;', - 'this.i = 0;' + 'this.i = 0;', + 'this.s = "";' ]), LinesToStr([ 'this.i=this.TMyEnum.Red;', @@ -2270,6 +2272,9 @@ begin 'this.e=this.e+1;', 'this.e=1;', 'this.e=this.i;', + 'this.s = this.TMyEnum[this.e];', + 'this.s = this.TMyEnum[this.e];', + 'this.s = rtl.spaceLeft(this.TMyEnum[this.e], 3);', ''])); end; @@ -2687,6 +2692,23 @@ begin ''])); end; +procedure TTestModule.TestNestBegin; +begin + StartProgram(false); + Add('begin'); + Add(' begin'); + Add(' begin'); + Add(' end;'); + Add(' begin'); + Add(' if true then ;'); + Add(' end;'); + Add(' end;'); + ConvertProgram; + CheckSource('TestNestBegin', + '', + 'if (true) ;'); +end; + procedure TTestModule.TestUnitImplVars; begin StartUnit(false); @@ -3103,6 +3125,55 @@ begin ''])); end; +procedure TTestModule.TestStr; +begin + StartProgram(false); + Add('var'); + Add(' b: boolean;'); + Add(' i: longint;'); + Add(' d: double;'); + Add(' s: string;'); + Add('begin'); + Add(' s:=str(b);'); + Add(' s:=str(i);'); + Add(' s:=str(d);'); + Add(' s:=str(i,i);'); + Add(' s:=str(i:3);'); + Add(' s:=str(d:3:2);'); + Add(' s:=str(i:4,i);'); + Add(' s:=str(i,i:5);'); + Add(' s:=str(i:4,i:5);'); + Add(' str(b,s);'); + Add(' str(i,s);'); + Add(' str(d,s);'); + Add(' str(i:3,s);'); + Add(' str(d:3:2,s);'); + ConvertProgram; + CheckSource('TestStr', + LinesToStr([ // statements + 'this.b = false;', + 'this.i = 0;', + 'this.d = 0.0;', + 'this.s = "";', + '']), + LinesToStr([ // this.$main + 'this.s = ""+this.b;', + 'this.s = ""+this.i;', + 'this.s = ""+this.d;', + 'this.s = (""+this.i)+this.i;', + 'this.s = rtl.spaceLeft(""+this.i,3);', + 'this.s = rtl.spaceLeft(this.d.toFixed(2),3);', + 'this.s = rtl.spaceLeft("" + this.i, 4) + this.i;', + 'this.s = ("" + this.i) + rtl.spaceLeft("" + this.i, 5);', + 'this.s = rtl.spaceLeft("" + this.i, 4) + rtl.spaceLeft("" + this.i, 5);', + 'this.s = ""+this.b;', + 'this.s = ""+this.i;', + 'this.s = ""+this.d;', + 'this.s = rtl.spaceLeft(""+this.i,3);', + 'this.s = rtl.spaceLeft(this.d.toFixed(2),3);', + ''])); +end; + procedure TTestModule.TestProcTwoArgs; begin StartProgram(false); @@ -3290,7 +3361,7 @@ begin ' var $loopend1 = 2;', ' for (this.vI = 1; this.vI <= $loopend1; this.vI++);', ' if(this.vI>$loopend1)this.vI--;', - ' if (this.vI==3){} ;' + ' if (this.vI==3) ;' ])); end; @@ -3389,7 +3460,7 @@ begin LinesToStr([ // this.$main 'this.vI = 1;', 'if (vI==1) {', - 'vI=2;', + ' vI=2;', '}', 'if (vI==2){ vI=3; }', ';', @@ -3452,6 +3523,11 @@ begin Add(' else'); Add(' vi:=5'); Add(' end;'); + Add(' try'); + Add(' VI:=6;'); + Add(' except'); + Add(' on einvalidcast do ;'); + Add(' end;'); ConvertProgram; CheckSource('TestTryExcept', LinesToStr([ // statements @@ -3479,21 +3555,27 @@ begin '};', 'try {', ' this.vI = 3;', - '} catch ('+DefaultJSExceptionObject+') {', - ' throw '+DefaultJSExceptionObject+';', + '} catch ('+DefaultVarNameExceptObject+') {', + ' throw '+DefaultVarNameExceptObject+';', '};', 'try {', ' this.vI = 4;', - '} catch ('+DefaultJSExceptionObject+') {', - ' if (this.EInvalidCast.isPrototypeOf('+DefaultJSExceptionObject+')) throw '+DefaultJSExceptionObject, - ' else if (this.Exception.isPrototypeOf('+DefaultJSExceptionObject+')) {', - ' var E = '+DefaultJSExceptionObject+';', + '} catch ('+DefaultVarNameExceptObject+') {', + ' if (this.EInvalidCast.isPrototypeOf('+DefaultVarNameExceptObject+')) throw '+DefaultVarNameExceptObject, + ' else if (this.Exception.isPrototypeOf('+DefaultVarNameExceptObject+')) {', + ' var E = '+DefaultVarNameExceptObject+';', ' if (E.Msg == "") throw E;', ' } else {', ' this.vI = 5;', ' }', - '};' - ])); + '};', + 'try {', + ' this.vI = 6;', + '} catch ('+DefaultVarNameExceptObject+') {', + ' if (this.EInvalidCast.isPrototypeOf('+DefaultVarNameExceptObject+')){' , + ' } else throw '+DefaultVarNameExceptObject, + '};', + ''])); end; procedure TTestModule.TestCaseOf; @@ -3614,8 +3696,7 @@ begin ]), LinesToStr([ // this.$main 'var $tmp1 = this.vI;', - 'if (($tmp1 >= 1) && ($tmp1 <= 3)) this.vI = 14 else if (($tmp1 == 4) || ($tmp1 == 5)) this.vI = 16 else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) {} else {', - '};' + 'if (($tmp1 >= 1) && ($tmp1 <= 3)) this.vI = 14 else if (($tmp1 == 4) || ($tmp1 == 5)) this.vI = 16 else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) ;' ])); end; @@ -3674,8 +3755,8 @@ begin ]), LinesToStr([ // this.$main 'this.Arr = [];', - 'if (this.Arr.length == 0) {};', - 'if (0 == this.Arr.length) {};', + 'if (this.Arr.length == 0);', + 'if (0 == this.Arr.length);', 'this.DoIt([],[]);', ''])); end; @@ -3714,8 +3795,8 @@ begin ]), LinesToStr([ // this.$main 'this.Arr2 = [];', - 'if (this.Arr2.length == 0) {};', - 'if (0 == this.Arr2.length) {};', + 'if (this.Arr2.length == 0);', + 'if (0 == this.Arr2.length);', 'this.i = 0;', 'this.i = 0;', 'this.i = this.Arr2.length-1;', @@ -4735,8 +4816,7 @@ begin 'this.oO = this.TObject.$create("Create");', 'this.oA = this.TClassA.$create("Create");', 'this.oB = this.TClassB.$create("Create");', - 'if (this.TClassA.isPrototypeOf(this.oO)) {', - '};', + 'if (this.TClassA.isPrototypeOf(this.oO));', 'this.oB = rtl.as(this.oO, this.TClassB);', 'rtl.as(this.oO, this.TClassB).ProcB();' ])); @@ -5065,7 +5145,7 @@ begin LinesToStr([ // this.$main 'this.Obj = this.TObject.$create("Create");', 'this.TObject.vI = 3;', - 'if (this.TObject.vI == 4){};', + 'if (this.TObject.vI == 4);', 'this.TObject.Sub=null;', 'this.Obj.$class.Sub=null;', 'this.Obj.Sub.$class.Sub=null;', @@ -5225,8 +5305,7 @@ begin ]), LinesToStr([ // this.$main 'this.Obj.Fy = this.Obj.Fx + 1;', - 'if (this.Obj.GetInt() == 2) {', - '};', + 'if (this.Obj.GetInt() == 2);', 'this.Obj.SetInt(this.Obj.GetInt() + 2);', 'this.Obj.SetInt(this.Obj.Fx);' ])); @@ -5297,13 +5376,11 @@ begin ]), LinesToStr([ // this.$main 'this.TObject.Fy = this.TObject.Fx + 1;', - 'if (this.TObject.GetInt() == 2) {', - '};', + 'if (this.TObject.GetInt() == 2);', 'this.TObject.SetInt(this.TObject.GetInt() + 2);', 'this.TObject.SetInt(this.TObject.Fx);', 'this.Obj.$class.Fy = this.Obj.Fx + 1;', - 'if (this.Obj.$class.GetInt() == 2) {', - '};', + 'if (this.Obj.$class.GetInt() == 2);', 'this.Obj.$class.SetInt(this.Obj.$class.GetInt() + 2);', 'this.Obj.$class.SetInt(this.Obj.Fx);' ])); @@ -5568,8 +5645,7 @@ begin 'this.b = false;' ]), LinesToStr([ // this.$main - 'if (this.Obj != null) {', - '};', + 'if (this.Obj != null);', 'this.b = (this.Obj != null) || false;' ])); end; @@ -5921,24 +5997,18 @@ begin 'this.ProcA = function (A) {', ' A.set(null);', ' A.set(A.get());', - ' if (A.get() == null) {', - ' };', - ' if (null == A.get()) {', - ' };', + ' if (A.get() == null);', + ' if (null == A.get());', '};', 'this.ProcB = function (A) {', ' A.set(null);', ' A.set(A.get());', - ' if (A.get() == null) {', - ' };', - ' if (null == A.get()) {', - ' };', + ' if (A.get() == null);', + ' if (null == A.get());', '};', 'this.ProcC = function (A) {', - ' if (A == null) {', - ' };', - ' if (null == A) {', - ' };', + ' if (A == null);', + ' if (null == A);', '};', 'this.o = null;', '']), diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 38c28fe6f8..7b774aa2c3 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -529,8 +529,7 @@ begin 'this.o = null;', '']), LinesToStr([ - 'if (this.o.FFoo){', - '};', + 'if (this.o.FFoo);', ''])); end; @@ -566,8 +565,7 @@ begin 'this.o = null;', '']), LinesToStr([ - 'if (this.o.GetFoo()){', - '};', + 'if (this.o.GetFoo()) ;', ''])); end;