From 6ef4c4af92b518ac0588109d85902c8fd4adeff4 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 29 Jan 2018 17:39:06 +0000 Subject: [PATCH] pastojs: external class const git-svn-id: trunk@38077 - --- packages/pastojs/src/fppas2js.pp | 73 +++++++++++++++++++--- packages/pastojs/src/pas2jspparser.pp | 2 +- packages/pastojs/tests/tcmodules.pas | 71 ++++++++++++++------- packages/pastojs/tests/tcoptimizations.pas | 4 +- 4 files changed, 117 insertions(+), 33 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 10075f0af8..6bbf93b93e 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2275,12 +2275,14 @@ begin RaiseVarModifierNotSupported(ClassFieldModifiersAllowed); if TPasClassType(El.Parent).IsExternal then begin - // external class -> make variable external - if El.Expr<>nil then - RaiseMsg(20180127111830,nIllegalQualifier,sIllegalQualifier, - ['='],El.Expr); + // external class + if El.Visibility=visPublished then + // Note: an external class has no typeinfo + RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished, + [],El); if not (vmExternal in El.VarModifiers) then begin + // make variable external if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst) then begin if El.ExportName<>nil then @@ -2290,10 +2292,9 @@ begin end; Include(El.VarModifiers,vmExternal); end; - if El.Visibility=visPublished then - // Note: an external class has no typeinfo - RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished, - [],El); + if (El.ClassType=TPasConst) and (TPasConst(El).Expr<>nil) then + // external const with expression is not writable + TPasConst(El).IsConst:=true; end; end else if ParentC=TPasRecordType then @@ -4970,6 +4971,27 @@ begin Result:=CreateArgumentAccess(TPasArgument(Decl),AContext,El); exit; end + else if Decl.ClassType=TPasConst then + begin + if TPasConst(Decl).IsConst and (TPasConst(Decl).Expr<>nil) then + begin + Value:=AContext.Resolver.Eval(TPasConst(Decl).Expr,[refConst]); + if (Value<>nil) + and (Value.Kind in [revkNil,revkBool,revkInt,revkUInt,revkFloat,revkEnum]) then + try + Result:=ConvertConstValue(Value,AContext,El); + exit; + finally + ReleaseEvalValue(Value); + end; + if vmExternal in TPasConst(Decl).VarModifiers then + begin + // external constant are always added by value, not by reference + Result:=ConvertElement(TPasConst(Decl).Expr,AContext); + exit; + end; + end; + end else if Decl.ClassType=TPasResString then begin // read resourcestring -> rtl.getResStr($mod,"name") @@ -9758,6 +9780,11 @@ end; function TPasToJSConverter.ConvertConstValue(Value: TResEvalValue; AContext: TConvertContext; El: TPasElement): TJSElement; +var + Ranges: TResEvalSet.TItems; + Range: TResEvalSet.TItem; + Call: TJSCallExpression; + i: Integer; begin Result:=nil; if Value=nil then @@ -9783,7 +9810,35 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.ConvertConstValue Value=',Value.AsDebugString,' IdentEl=',GetObjName(Value.IdentEl)); {$ENDIF} - RaiseNotSupported(El,AContext,20171221125842); + // rtl.createSet() + Call:=CreateCallExpression(El); + try + Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]); + Ranges:=TResEvalSet(Value).Ranges; + for i:=0 to length(Ranges)-1 do + begin + Range:=Ranges[i]; + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertConstValue SetLiteral ',i,' ',Range.RangeStart,'..',Range.RangeEnd); + {$ENDIF} + if Range.RangeStart=Range.RangeEnd then + begin + // add one integer + Call.AddArg(CreateLiteralNumber(El,Range.RangeStart)); + end + else + begin + // range -> add three parameters: null,left,right + Call.AddArg(CreateLiteralNull(El)); + Call.AddArg(CreateLiteralNumber(El,Range.RangeStart)); + Call.AddArg(CreateLiteralNumber(El,Range.RangeEnd)); + end; + end; + Result:=Call; + finally + if Result=nil then + Call.Free; + end; end else {$IFDEF VerbosePas2JS} diff --git a/packages/pastojs/src/pas2jspparser.pp b/packages/pastojs/src/pas2jspparser.pp index 1b58febb4b..3051a7ccdf 100644 --- a/packages/pastojs/src/pas2jspparser.pp +++ b/packages/pastojs/src/pas2jspparser.pp @@ -109,7 +109,7 @@ constructor TPas2jsPasParser.Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer); begin inherited Create(AScanner,AFileResolver,AEngine); - Options:=Options+[po_asmwhole,po_resolvestandardtypes]; + Options:=Options+[po_AsmWhole,po_ResolveStandardTypes,po_ExtClassConstWithoutExpr]; end; procedure TPas2jsPasParser.SetLastMsg(MsgType: TMessageType; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 4ab7a39022..d6d34b3ca5 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -31,7 +31,7 @@ uses const // default parser+scanner options - po_pas2js = [po_asmwhole,po_resolvestandardtypes]; + po_pas2js = [po_asmwhole,po_resolvestandardtypes,po_ExtClassConstWithoutExpr]; co_tcmodules = [coNoTypeInfo]; type @@ -427,7 +427,7 @@ type // external class Procedure TestExternalClass_Var; - Procedure TestExternalClass_ConstFail; + Procedure TestExternalClass_Const; Procedure TestExternalClass_Dollar; Procedure TestExternalClass_DuplicateVarFail; Procedure TestExternalClass_Method; @@ -3144,10 +3144,10 @@ begin CheckSource('TestProc_ConstOrder', LinesToStr([ // statements 'this.A = 3;', - 'this.B = $mod.A + 1;', - 'var C = $mod.A + 1;', - 'var D = $mod.B + 1;', - 'var E = ((D + C) + $mod.B) + $mod.A;', + 'this.B = 3 + 1;', + 'var C = 3 + 1;', + 'var D = 4 + 1;', + 'var E = ((5 + 4) + 4) + 3;', 'this.DoIt = function () {', '};', '']), @@ -3933,10 +3933,10 @@ begin 'this.Enums = {};', '']), LinesToStr([ - '$mod.Enums = rtl.includeSet($mod.Enums, $mod.Orange);', - '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.Orange);', - 'if ($mod.Orange in $mod.Enums) ;', - 'if ($mod.Orange in rtl.createSet($mod.Orange, $mod.TEnum.Red)) ;', + '$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);', + '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);', + 'if ($mod.TEnum.Red in $mod.Enums) ;', + 'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;', ''])); end; @@ -3977,16 +3977,16 @@ begin '']), LinesToStr([ '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);', - '$mod.f = rtl.includeSet($mod.f, $mod.favorite);', + '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);', + '$mod.i = $mod.TFlags$a.red;', '$mod.i = $mod.TFlags$a.red;', - '$mod.i = $mod.favorite;', '$mod.i = $mod.TFlags$a.red;', '$mod.i = $mod.TFlags$a.red;', '$mod.i = $mod.TFlags$a.red;', '$mod.i = $mod.TFlags$a.green;', '$mod.i = $mod.TFlags$a.green;', '$mod.i = $mod.TFlags$a.green;', - '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.favorite);', + '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);', ''])); end; @@ -4301,10 +4301,10 @@ begin 'var cB$1 = 4;', 'this.DoIt = function () {', ' function Sub() {', - ' cB$1 = cB$1 + csA;', - ' cA = (cA + csA) + 5;', + ' cB$1 = cB$1 + 3;', + ' cA = (cA + 3) + 5;', ' };', - ' cA = (cA + cB) + 6;', + ' cA = (cA + 2) + 6;', '};' ]), LinesToStr([ @@ -10480,18 +10480,47 @@ begin ''])); end; -procedure TTestModule.TestExternalClass_ConstFail; +procedure TTestModule.TestExternalClass_Const; begin StartProgram(false); Add([ '{$modeswitch externalclass}', 'type', ' TExtA = class external name ''ExtObj''', - ' const Id: longint = 3;', + ' const Two: longint = 2;', + ' const Three = 3;', + ' const Id: longint;', ' end;', - 'begin']); - SetExpectedPasResolverError('illegal qualifier "="',nIllegalQualifier); + ' TExtB = class external name ''ExtB''', + ' A: TExtA;', + ' end;', + 'var', + ' A: texta;', + ' B: textb;', + ' i: longint;', + 'begin', + ' i:=a.two;', + ' i:=texta.two;', + ' i:=a.three;', + ' i:=texta.three;', + ' i:=a.id;', + ' i:=texta.id;', + '']); ConvertProgram; + CheckSource('TestExternalClass_Dollar', + LinesToStr([ // statements + 'this.A = null;', + 'this.B = null;', + 'this.i = 0;', + '']), + LinesToStr([ // $mod.$main + '$mod.i = 2;', + '$mod.i = 2;', + '$mod.i = 3;', + '$mod.i = 3;', + '$mod.i = $mod.A.Id;', + '$mod.i = ExtObj.Id;', + ''])); end; procedure TTestModule.TestExternalClass_Dollar; @@ -11111,7 +11140,7 @@ begin Add(' constructor New;'); Add(' end;'); Add('function DoIt: longint;'); - Add('const ExtA = 3;'); + Add('const ExtA: longint = 3;'); Add('begin'); Add(' Result:=ExtA;'); Add('end;'); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 48949b82bc..8d48caacc4 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -264,7 +264,7 @@ begin 'var d = 6;', 'this.DoIt = function () {', ' var Result = 0;', - ' Result = b + d;', + ' Result = 4 + d;', ' return Result;', '};', '']), @@ -819,7 +819,7 @@ begin ' });', ' this.T = null;', ' $mod.$main = function () {', - ' $mod.T = $mod.TObject.$create("Create",[$mod.gcBlack]);', + ' $mod.T = $mod.TObject.$create("Create",[0]);', ' };', '});', '']);