From 65ae09a914db60419bace8777ff06b13d01733b2 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Tue, 24 Apr 2018 11:51:49 +0000 Subject: [PATCH] pastojs: range check char:=, char parameter git-svn-id: trunk@38831 - --- packages/pastojs/src/fppas2js.pp | 96 +++++++++++++++++++++------- packages/pastojs/tests/tcmodules.pas | 57 ++++++++++++++--- utils/pas2js/dist/rtl.js | 9 +++ 3 files changed, 132 insertions(+), 30 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 35557f0691..0f145ebbf4 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -281,8 +281,9 @@ Works: - type cast to class-type and class-of-type, rtl.asExt, EInvalidCast - Range checks: - compile time: warnings to errors - - assign int:=, int+=, enum:=, enum+=, intrange:=, intrange+=, enumrange:=, enumrange+= - - procedure argument int, enum, intrange, enumrange + - assign int:=, int+=, enum:=, enum+=, intrange:=, intrange+=, + enumrange:=, enumrange+=, char:=, char+= + - procedure argument int, enum, intrange, enumrange, char - Interfaces: - autogenerate GUID - method resolution @@ -341,7 +342,6 @@ ToDos: v:=a[0] gives Local variable "a" is assigned but never used - setlength(dynarray) modeswitch to create a copy - range checks: - - char:= - proc(c: char) - string[index] - array[index,...] @@ -533,6 +533,7 @@ type pbifnProcType_Equal, pbifnProgramMain, pbifnRangeCheckInt, + pbifnRangeCheckChar, pbifnRecordEqual, pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField pbifnRTTIAddFields, // typeinfos of tkclass and tkrecord have addFields @@ -670,7 +671,8 @@ const 'createCallback', // rtl.createCallback 'eqCallback', // rtl.eqCallback '$main', - 'rc', + 'rc', // rtl.rc + 'rcc', // rtl.rcc '$equal', 'addField', 'addFields', @@ -7342,6 +7344,7 @@ var ParamTypeEl, TypeEl: TPasType; aResolver: TPas2JSResolver; NeedIntfRef: Boolean; + DestRange, SrcRange: TResEvalValue; begin Result:=nil; if El.Kind<>pekFuncParams then @@ -7431,6 +7434,7 @@ begin or (C=TPasClassOfType) or (C=TPasRecordType) or (C=TPasEnumType) + or (C=TPasRangeType) or (C=TPasArrayType) then begin // typecast @@ -7441,7 +7445,45 @@ begin Result:=ConvertElement(Param,AContext); - if C=TPasClassType then + if C=TPasRangeType then + begin + DestRange:=aResolver.EvalTypeRange(TPasRangeType(Decl),[refConst]); + SrcRange:=nil; + try + if DestRange=nil then + RaiseNotSupported(El,AContext,20180424124708); + SrcRange:=aResolver.EvalTypeRange(ParamResolved.TypeEl,[]); + if SrcRange=nil then + RaiseNotSupported(El,AContext,20180424125331); + case DestRange.Kind of + revkRangeInt: + case TResEvalRangeInt(DestRange).ElKind of + revskEnum, revskInt: + // type cast to integer-range + case SrcRange.Kind of + revkRangeInt: + case TResEvalRangeInt(SrcRange).ElKind of + revskEnum, revskInt: + ; // ToDo: higher precision to lower precision -> modulo + else + RaiseNotSupported(El,AContext,20180424130705); + end; + revkRangeUInt: ; + else + RaiseNotSupported(El,AContext,20180424125608); + end; + else + RaiseNotSupported(El,AContext,20180424125419); + end; + else + RaiseNotSupported(El,AContext,20180424124814); + end; + finally + ReleaseEvalValue(SrcRange); + ReleaseEvalValue(DestRange); + end; + end + else if C=TPasClassType then begin if ParamTypeEl is TPasClassType then case TPasClassType(Decl).ObjKind of @@ -7548,6 +7590,7 @@ begin begin aResolver.ComputeElement(Decl,DeclResolved,[rcType]); if DeclResolved.TypeEl is TPasProcedureType then + // e.g. OnClick() TargetProcType:=TPasProcedureType(DeclResolved.TypeEl) else RaiseNotSupported(El,AContext,20170217115244); @@ -11238,13 +11281,14 @@ var BodyJS.A:=FirstSt; end; - procedure AddRangeCheckInt(Arg: TPasArgument; MinVal, MaxVal: MaxPrecInt); + procedure AddRangeCheck(Arg: TPasArgument; MinVal, MaxVal: MaxPrecInt; + RTLFunc: TPas2JSBuiltInName); var Call: TJSCallExpression; begin // use Arg as PosEl, so that user knows which Arg is out of range Call:=CreateCallExpression(Arg); - Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnRangeCheckInt],El); + Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[RTLFunc],El); AddBodyStatement(Call,Arg); Call.AddArg(CreateArgumentAccess(Arg,AContext,Arg)); Call.AddArg(CreateLiteralNumber(Arg,MinVal)); @@ -11263,13 +11307,15 @@ var revkRangeInt: case TResEvalRangeInt(Value).ElKind of revskEnum, revskInt: - AddRangeCheckInt(Arg,TResEvalRangeInt(Value).RangeStart, - TResEvalRangeInt(Value).RangeEnd); - revskChar: ; // ToDo + AddRangeCheck(Arg,TResEvalRangeInt(Value).RangeStart, + TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckInt); + revskChar: + AddRangeCheck(Arg,TResEvalRangeInt(Value).RangeStart, + TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckChar); end; revkRangeUInt: - AddRangeCheckInt(Arg,TResEvalRangeUInt(Value).RangeStart, - TResEvalRangeUInt(Value).RangeEnd); + AddRangeCheck(Arg,TResEvalRangeUInt(Value).RangeStart, + TResEvalRangeUInt(Value).RangeEnd,pbifnRangeCheckInt); else RaiseNotSupported(Arg,AContext,20180424112010,'range checking '+Value.AsDebugString); end; @@ -11400,11 +11446,13 @@ begin begin if not aResolver.GetIntegerRange(ArgResolved.BaseType,MinVal,MaxVal) then RaiseNotSupported(Arg,AContext,20180119192608); - AddRangeCheckInt(Arg,MinVal,MaxVal); + AddRangeCheck(Arg,MinVal,MaxVal,pbifnRangeCheckInt); end else if ArgTypeEl.ClassType=TPasRangeType then AddRangeCheckType(Arg,ArgTypeEl); end + else if ArgResolved.BaseType in btAllJSChars then + AddRangeCheckType(Arg,ArgTypeEl) else if ArgResolved.BaseType=btContext then begin if ArgTypeEl.ClassType=TPasEnumType then @@ -13676,13 +13724,13 @@ function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign; +GetResolverResultDbg(AssignContext.RightResolved)); end; - function CreateRangeCheckInt(AssignSt: TJSElement; - MinVal, MaxVal: MaxPrecInt): TJSElement; + function CreateRangeCheck(AssignSt: TJSElement; + MinVal, MaxVal: MaxPrecInt; RTLFunc: TPas2JSBuiltInName): TJSElement; var Call: TJSCallExpression; begin Call:=CreateCallExpression(El); - Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnRangeCheckInt],El); + Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[RTLFunc],El); if AssignSt.ClassType=TJSSimpleAssignStatement then begin // LHS:=rtl.rc(RHS,min,max) check before assign @@ -13713,13 +13761,15 @@ function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign; revkRangeInt: case TResEvalRangeInt(Value).ElKind of revskEnum, revskInt: - Result:=CreateRangeCheckInt(AssignSt,TResEvalRangeInt(Value).RangeStart, - TResEvalRangeInt(Value).RangeEnd); - revskChar: ; // ToDo + Result:=CreateRangeCheck(AssignSt,TResEvalRangeInt(Value).RangeStart, + TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckInt); + revskChar: + Result:=CreateRangeCheck(AssignSt,TResEvalRangeInt(Value).RangeStart, + TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckChar); end; revkRangeUInt: - Result:=CreateRangeCheckInt(AssignSt,TResEvalRangeUInt(Value).RangeStart, - TResEvalRangeUInt(Value).RangeEnd); + Result:=CreateRangeCheck(AssignSt,TResEvalRangeUInt(Value).RangeStart, + TResEvalRangeUInt(Value).RangeEnd,pbifnRangeCheckInt); else RaiseNotSupported(El,AContext,20180424111037,'range checking '+Value.AsDebugString); end; @@ -13997,11 +14047,13 @@ begin begin if not aResolver.GetIntegerRange(AssignContext.LeftResolved.BaseType,MinVal,MaxVal) then RaiseNotSupported(El.left,AContext,20180119154120); - Result:=CreateRangeCheckInt(Result,MinVal,MaxVal); + Result:=CreateRangeCheck(Result,MinVal,MaxVal,pbifnRangeCheckInt); end else if LeftTypeEl.ClassType=TPasRangeType then Result:=CreateRangeCheckType(Result,LeftTypeEl); end + else if AssignContext.LeftResolved.BaseType in btAllJSChars then + Result:=CreateRangeCheckType(Result,LeftTypeEl) else if AssignContext.LeftResolved.BaseType=btContext then begin if LeftTypeEl.ClassType=TPasEnumType then diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index aec3405726..8712a1a58d 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -635,6 +635,7 @@ type procedure TestRangeChecks_AssignIntRange; procedure TestRangeChecks_AssignEnum; procedure TestRangeChecks_AssignEnumRange; + procedure TestRangeChecks_AssignChar; end; function LinesToStr(Args: array of const): string; @@ -19878,13 +19879,13 @@ begin 'procedure DoIt(p: TEnum);', 'begin', ' e:=p;', - ' p:=red;', + ' p:=TEnum(0);', ' p:=succ(e);', 'end;', '{$R-}', 'begin', ' DoIt(e);', - ' e:=green;', + ' e:=TEnum(1);', ' e:=pred(e);', '{$R+}', '']); @@ -19901,13 +19902,13 @@ begin 'this.DoIt = function (p) {', ' rtl.rc(p, 0, 1);', ' $mod.e = rtl.rc(p, 0, 1);', - ' p = rtl.rc($mod.TEnum.red, 0, 1);', + ' p = 0;', ' p = rtl.rc($mod.e + 1, 0, 1);', '};', '']), LinesToStr([ // $mod.$main '$mod.DoIt($mod.e);', - '$mod.e = rtl.rc($mod.TEnum.green, 0, 1);', + '$mod.e = 1;', '$mod.e = rtl.rc($mod.e-1, 0, 1);', ''])); end; @@ -19925,13 +19926,13 @@ begin 'procedure DoIt(p: TEnumRg);', 'begin', ' e:=p;', - ' p:=red;', + ' p:=TEnumRg(0);', ' p:=succ(e);', 'end;', '{$R-}', 'begin', ' DoIt(e);', - ' e:=green;', + ' e:=TEnumRg(1);', ' e:=pred(e);', '{$R+}', '']); @@ -19948,17 +19949,57 @@ begin 'this.DoIt = function (p) {', ' rtl.rc(p, 0, 1);', ' $mod.e = rtl.rc(p, 0, 1);', - ' p = rtl.rc($mod.TEnum.red, 0, 1);', + ' p = 0;', ' p = rtl.rc($mod.e + 1, 0, 1);', '};', '']), LinesToStr([ // $mod.$main '$mod.DoIt($mod.e);', - '$mod.e = rtl.rc($mod.TEnum.green, 0, 1);', + '$mod.e = 1;', '$mod.e = rtl.rc($mod.e-1, 0, 1);', ''])); end; +procedure TTestModule.TestRangeChecks_AssignChar; +begin + Scanner.Options:=Scanner.Options+[po_CAssignments]; + StartProgram(false); + Add([ + '{$R+}', + 'type TLetter = char;', + 'var', + ' b: TLetter = ''2'';', + ' w: TLetter = ''3'';', + 'procedure DoIt(p: TLetter);', + 'begin', + ' b:=w;', + ' b:=''1'';', + 'end;', + '{$R-}', + 'begin', + ' DoIt(w);', + ' b:=w;', + ' b:=''2'';', + '{$R+}', + '']); + ConvertProgram; + CheckSource('TestRangeChecks_AssignChar', + LinesToStr([ // statements + 'this.b = "2";', + 'this.w = "3";', + 'this.DoIt = function (p) {', + ' rtl.rcc(p, 0, 65535);', + ' $mod.b = rtl.rcc($mod.w, 0, 65535);', + ' $mod.b = "1";', + '};', + '']), + LinesToStr([ // $mod.$main + '$mod.DoIt($mod.w);', + '$mod.b = rtl.rcc($mod.w, 0, 65535);', + '$mod.b = "2";', + ''])); +end; + Initialization RegisterTests([TTestModule]); end. diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index f74e66b348..68857dd12d 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -650,6 +650,15 @@ var rtl = { rtl.raiseE('ERangeError'); }, + rcc: function(c,minval,maxval){ + // range check char + if (typeof(c)==='string') && (c.length===1)){ + var i = c.charCodeAt(0); + if ((i>=minval) && (i<=maxval)) return c; + } + rtl.raiseE('ERangeError'); + }, + length: function(arr){ return (arr == null) ? 0 : arr.length; },