pastojs: range check array index

git-svn-id: trunk@38834 -

packages/pastojs/src/fppas2js.pp

@@ -282,8 +282,8 @@ Works:
 - Range checks:
   - compile time: warnings to errors
   - assign int:=, int+=, enum:=, enum+=, intrange:=, intrange+=,
-      enumrange:=, enumrange+=, char:=, char+=
-  - procedure argument int, enum, intrange, enumrange, char
+      enumrange:=, enumrange+=, char:=, char+=, charrange:=, charrange+=
+  - procedure argument int, enum, intrange, enumrange, char, charrange
 - Interfaces:
   - autogenerate GUID
   - method resolution
@@ -342,10 +342,8 @@ ToDos:
   v:=a[0]  gives Local variable "a" is assigned but never used
 - setlength(dynarray)  modeswitch to create a copy
 - range checks:
-  - proc(c: char)
   - string[index]
   - array[index,...]
-  - prop[index,...]
   - case duplicates
 - typecast longint(highprecint) -> value & $ffffffff
 - static arrays
@@ -532,8 +530,10 @@ type
     pbifnProcType_Create,
     pbifnProcType_Equal,
     pbifnProgramMain,
-    pbifnRangeCheckInt,
+    pbifnRangeCheckArrayRead,
+    pbifnRangeCheckArrayWrite,
     pbifnRangeCheckChar,
+    pbifnRangeCheckInt,
     pbifnRecordEqual,
     pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField
     pbifnRTTIAddFields, // typeinfos of tkclass and tkrecord have addFields
@@ -671,8 +671,10 @@ const
     'createCallback', // rtl.createCallback
     'eqCallback', // rtl.eqCallback
     '$main',
-    'rc',  // rtl.rc
+    'rcArrR',  // rtl.rcArrR
+    'rcArrW',  // rtl.rcArrW
     'rcc', // rtl.rcc
+    'rc',  // rtl.rc
     '$equal',
     'addField',
     'addFields',
@@ -6801,9 +6803,9 @@ var
 
   procedure ConvertArray(ArrayEl: TPasArrayType);
   var
-    B, Sub: TJSBracketMemberExpression;
+    BracketEx, Sub: TJSBracketMemberExpression;
     i, ArgNo: Integer;
-    Arg: TJSElement;
+    Arg, ArrJS: TJSElement;
     OldAccess: TCtxAccess;
     Ranges: TPasExprArray;
     Int: MaxPrecInt;
@@ -6812,17 +6814,26 @@ var
     LowRg: TResEvalValue;
     JSUnaryPlus: TJSUnaryPlusExpression;
     w: WideChar;
+    IsRangeCheck, ok, NeedRangeCheck: Boolean;
+    CallEx: TJSCallExpression;
+    AssignContext: TAssignContext;
+    ArgList: TFPList;
   begin
     Arg:=nil;
-    B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    BracketEx:=nil;
+    ArrJS:=nil;
+    CallEx:=nil;
+    ArgList:=TFPList.Create;
+    NeedRangeCheck:=false;
+
+    ok:=false;
     try
       // add read accessor
       OldAccess:=AContext.Access;
       AContext.Access:=caRead;
-      B.MExpr:=ConvertElement(El.Value,AContext);
+      ArrJS:=ConvertElement(El.Value,AContext);
       AContext.Access:=OldAccess;
 
-      Result:=B;
       ArgNo:=0;
       repeat
         // Note: dynamic array has length(ArrayEl.Ranges)=0
@@ -6834,6 +6845,8 @@ var
           ArgContext.Access:=caRead;
           Arg:=ConvertElement(Param,ArgContext);
           ArgContext.Access:=OldAccess;
+          if not (Arg is TJSLiteral) then
+            NeedRangeCheck:=true;
 
           if i<=length(Ranges) then
             begin
@@ -6947,14 +6960,7 @@ var
             ReleaseEvalValue(LowRg);
             end;
 
-          if B.Name<>nil then
-            begin
-            // nested [][]
-            Sub:=B;
-            B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
-            B.MExpr:=Sub;
-            end;
-          B.Name:=Arg;
+          ArgList.Add(Arg);
           Arg:=nil;
           inc(ArgNo);
           if ArgNo>length(El.Params) then
@@ -6965,12 +6971,63 @@ var
         // continue in sub array
         ArrayEl:=AContext.Resolver.ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
       until false;
-      Result:=B;
+
+      IsRangeCheck:=NeedRangeCheck
+                and (bsRangeChecks in AContext.ScannerBoolSwitches)
+                and (AContext.Access in [caRead,caAssign]);
+
+      if IsRangeCheck then
+        begin
+        // read a[i,j,k]  ->  rtl.rcArrR(a,i,j,k)
+        // assign a[i,j,k]=RHS  ->  rtl.rcArrW(a,i,j,k,RHS)
+        CallEx:=CreateCallExpression(El);
+        Result:=CallEx;
+        if AContext.Access=caRead then
+          CallEx.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnRangeCheckArrayRead],El)
+        else
+          CallEx.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnRangeCheckArrayWrite],El);
+        CallEx.AddArg(ArrJS); ArrJS:=nil;
+        for i:=0 to ArgList.Count-1 do
+         CallEx.AddArg(TJSElement(ArgList[i]));
+        ArgList.Clear;
+        if AContext.Access=caAssign then
+          begin
+          AssignContext:=AContext.AccessContext as TAssignContext;
+          if AssignContext.Call<>nil then
+            RaiseNotSupported(El,AContext,20180424192155);
+          CallEx.AddArg(AssignContext.RightSide);
+          AssignContext.RightSide:=nil;
+          AssignContext.Call:=CallEx;
+          end;
+        end
+      else
+        begin
+        BracketEx:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+        BracketEx.MExpr:=ArrJS; ArrJS:=nil;
+        for i:=0 to ArgList.Count-1 do
+          begin
+          if BracketEx.Name<>nil then
+            begin
+            // nested [][]
+            Sub:=BracketEx;
+            BracketEx:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+            BracketEx.MExpr:=Sub;
+            end;
+          BracketEx.Name:=TJSElement(ArgList[i]);
+          end;
+        Result:=BracketEx;
+        ArgList.Clear;
+        end;
+
+      ok:=true;
     finally
-      if Result=nil then
+      if not ok then
         begin
+        ArrJS.Free;
+        for i:=0 to ArgList.Count-1 do TJSElement(ArgList[i]).Free;
+        ArgList.Free;
         Arg.Free;
-        B.Free;
+        Result.Free;
         end;
     end;
   end;
@@ -11460,7 +11517,9 @@ begin
             end
           else if ArgResolved.BaseType=btRange then
             begin
-            if ArgResolved.SubType=btContext then
+            if ArgResolved.SubType in btAllJSChars then
+              AddRangeCheckType(Arg,ArgTypeEl)
+            else if ArgResolved.SubType=btContext then
               AddRangeCheckType(Arg,ArgTypeEl)
             else
               begin
@@ -14061,7 +14120,9 @@ begin
           end
         else if AssignContext.LeftResolved.BaseType=btRange then
           begin
-          if AssignContext.LeftResolved.SubType=btContext then
+          if AssignContext.LeftResolved.SubType in btAllJSChars then
+            Result:=CreateRangeCheckType(Result,LeftTypeEl)
+          else if AssignContext.LeftResolved.SubType=btContext then
             Result:=CreateRangeCheckType(Result,LeftTypeEl)
           else
             begin

packages/pastojs/tests/tcmodules.pas

@@ -636,6 +636,8 @@ type
     procedure TestRangeChecks_AssignEnum;
     procedure TestRangeChecks_AssignEnumRange;
     procedure TestRangeChecks_AssignChar;
+    procedure TestRangeChecks_AssignCharRange;
+    procedure TestRangeChecks_ArrayIndex;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -19962,7 +19964,6 @@ end;
 
 procedure TTestModule.TestRangeChecks_AssignChar;
 begin
-  Scanner.Options:=Scanner.Options+[po_CAssignments];
   StartProgram(false);
   Add([
   '{$R+}',
@@ -20000,6 +20001,107 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRangeChecks_AssignCharRange;
+begin
+  StartProgram(false);
+  Add([
+  '{$R+}',
+  'type TDigit = ''0''..''9'';',
+  'var',
+  '  b: TDigit = ''2'';',
+  '  w: TDigit = ''3'';',
+  'procedure DoIt(p: TDigit);',
+  'begin',
+  '  b:=w;',
+  '  b:=''1'';',
+  'end;',
+  '{$R-}',
+  'begin',
+  '  DoIt(w);',
+  '  b:=w;',
+  '  b:=''2'';',
+  '{$R+}',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRangeChecks_AssignCharRange',
+    LinesToStr([ // statements
+    'this.b = "2";',
+    'this.w = "3";',
+    'this.DoIt = function (p) {',
+    '  rtl.rcc(p, 48, 57);',
+    '  $mod.b = rtl.rcc($mod.w, 48, 57);',
+    '  $mod.b = "1";',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.w);',
+    '$mod.b = rtl.rcc($mod.w, 48, 57);',
+    '$mod.b = "2";',
+    '']));
+end;
+
+procedure TTestModule.TestRangeChecks_ArrayIndex;
+begin
+  StartProgram(false);
+  Add([
+  '{$R+}',
+  'type',
+  '  Ten = 1..10;',
+  '  TArr = array of Ten;',
+  '  TArrArr = array of TArr;',
+  '  TArrByte = array[byte] of Ten;',
+  '  TArrChar = array[''0''..''9''] of Ten;',
+  '  TArrByteChar = array[byte,''0''..''9''] of Ten;',
+  'procedure DoIt;',
+  'var',
+  '  Arr: TArr;',
+  '  ArrArr: TArrArr;',
+  '  ArrByte: TArrByte;',
+  '  ArrChar: TArrChar;',
+  '  ArrByteChar: TArrByteChar;',
+  '  i: Ten;',
+  '  c: char;',
+  'begin',
+  '  i:=Arr[1];',
+  '  i:=ArrByteChar[1,''2''];',
+  '  Arr[1]:=Arr[1];',
+  '  Arr[i]:=Arr[i];',
+  '  ArrByte[3]:=ArrByte[3];',
+  '  ArrByte[i]:=ArrByte[i];',
+  '  ArrChar[''5'']:=ArrChar[''5''];',
+  '  ArrChar[c]:=ArrChar[c];',
+  '  ArrByteChar[7,''7'']:=ArrByteChar[7,''7''];',
+  '  ArrByteChar[i,c]:=ArrByteChar[i,c];',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRangeChecks_AssignChar',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var Arr = [];',
+    '  var ArrArr = [];',
+    '  var ArrByte = rtl.arraySetLength(null, 1, 256);',
+    '  var ArrChar = rtl.arraySetLength(null, 1, 10);',
+    '  var ArrByteChar = rtl.arraySetLength(null, 1, 256, 10);',
+    '  var i = 1;',
+    '  var c = "";',
+    '  i = rtl.rc(Arr[1], 1, 10);',
+    '  i = rtl.rc(ArrByteChar[1][2], 1, 10);',
+    '  Arr[1] = rtl.rc(Arr[1], 1, 10);',
+    '  rtl.rcArrW(Arr, i, rtl.rcArrR(Arr, i));',
+    '  ArrByte[3] = rtl.rc(ArrByte[3], 1, 10);',
+    '  rtl.rcArrW(ArrByte, i, rtl.rcArrR(ArrByte, i));',
+    '  ArrChar[5] = rtl.rc(ArrChar[5], 1, 10);',
+    '  rtl.rcArrW(ArrChar, c.charCodeAt() - 48, rtl.rcArrR(ArrChar, c.charCodeAt() - 48));',
+    '  ArrByteChar[7][7] = rtl.rc(ArrByteChar[7][7], 1, 10);',
+    '  rtl.rcArrW(ArrByteChar, i, c.charCodeAt() - 48, rtl.rcArrR(ArrByteChar, i, c.charCodeAt() - 48));',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.

utils/pas2js/dist/rtl.js

@@ -659,6 +659,34 @@ var rtl = {
     rtl.raiseE('ERangeError');
   },
 
+  rcArrR: function(arr,index){
+    // range check read array
+    if (Array.isArray(arr) && (typeof(index)==='number') && (index>=0) && (index<arr.length)){
+      if (arguments.length>2){
+        // arr,index1,index2,...
+        arr=arr[index];
+        for (var i=2; i<arguments.length; i++) arr=rtl.rcArrR(arr,arguments[i]);
+        return arr;
+      }
+      return arr[index];
+    }
+    rtl.raiseE('ERangeError');
+  },
+
+  rcArrW: function(arr,index,value){
+    // range check write array
+    // arr,index1,index2,...,value
+    for (var i=3; i<arguments.length; i++){
+      arr=rcArrR(arr,index);
+      index=arguments[i-1];
+      value=arguments[i];
+    }
+    if (Array.isArray(arr) && (typeof(index)==='number') && (index>=0) && (index<arr.length)){
+      return arr[index]=value;
+    }
+    rtl.raiseE('ERangeError');
+  },
+
   length: function(arr){
     return (arr == null) ? 0 : arr.length;
   },