Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 19 additions & 15 deletions Source/dwsArrayExprs.pas
Original file line number Diff line number Diff line change
Expand Up @@ -778,14 +778,14 @@ implementation
// this needs to be in a helper (or more precisely implemented at the top of this unit)
// otherwise inlining won't work
TBoundsHelper = class helper for TProgramExpr
procedure BoundsCheck(exec : TdwsExecution; aLength, index : Integer); inline;
procedure BoundsCheck(exec : TdwsExecution; aLength, index : Int64); inline;
end;

// BoundsCheck
//
procedure TBoundsHelper.BoundsCheck(exec : TdwsExecution; aLength, index : Integer);
procedure TBoundsHelper.BoundsCheck(exec : TdwsExecution; aLength, index : Int64);
begin
if Cardinal(index)>=Cardinal(aLength) then
if UInt64(index)>=UInt64(aLength) then
BoundsCheckFailed(exec, index);
end;

Expand Down Expand Up @@ -1252,7 +1252,7 @@ function TStaticArrayExpr.GetIndex(exec : TdwsExecution) : Int64;
// Get index
Result := FIndexExpr.EvalAsInteger(exec) - FLowBound;

if NativeUInt(Result) >= NativeUInt(FCount) then begin
if UInt64(Result) >= UInt64(FCount) then begin
if Result >= FCount then
RaiseUpperExceeded(exec, Result + FLowBound)
else RaiseLowerExceeded(exec, Result + FLowBound);
Expand Down Expand Up @@ -1333,7 +1333,7 @@ constructor TOpenArrayExpr.Create(const aScriptPos: TScriptPos;
//
procedure TOpenArrayExpr.GetDataPtr(exec : TdwsExecution; var result : IDataContext);
var
index : Integer;
index : Int64;
begin
index := FIndexExpr.EvalAsInteger(exec);

Expand Down Expand Up @@ -1647,11 +1647,13 @@ destructor TDynamicArraySetExpr.Destroy;
procedure TDynamicArraySetExpr.EvalNoResult(exec : TdwsExecution);
var
dyn : IScriptDynArray;
index : Integer;
index : Int64;
begin
ArrayExpr.EvalAsScriptDynArray(exec, dyn);
index := IndexExpr.EvalAsInteger(exec);
if not dyn.SetFromExpr(index, exec, ValueExpr) then
// bounds-checked here rather than through SetFromExpr: the index is Int64,
// but SetFromExpr takes NativeInt, which truncates on 32 bit targets
if (not dyn.BoundsCheckPassed(index)) or (not dyn.SetFromExpr(index, exec, ValueExpr)) then
BoundsCheckFailed(exec, index);
end;

Expand Down Expand Up @@ -1696,11 +1698,12 @@ function TDynamicArraySetExpr.GetSubExprCount : Integer;
procedure TDynamicArraySetVarExpr.EvalNoResult(exec : TdwsExecution);
var
p : PIUnknown;
index : Integer;
index : Int64;
begin
p := exec.Stack.PointerToInterfaceValue_BaseRelative(TObjectVarExpr(ArrayExpr).StackAddr);
index := IndexExpr.EvalAsInteger(exec);
if not IScriptDynArray(p^).SetFromExpr(index, exec, ValueExpr) then
if (not IScriptDynArray(p^).BoundsCheckPassed(index))
or (not IScriptDynArray(p^).SetFromExpr(index, exec, ValueExpr)) then
BoundsCheckFailed(exec, index);
end;

Expand All @@ -1713,7 +1716,7 @@ procedure TDynamicArraySetVarExpr.EvalNoResult(exec : TdwsExecution);
procedure TDynamicArraySetDataExpr.EvalNoResult(exec : TdwsExecution);
var
dynDataArray : TScriptDynamicDataArray;
index : Integer;
index : Int64;
base : IScriptDynArray;
dataExpr : TDataExpr;
begin
Expand Down Expand Up @@ -2095,7 +2098,7 @@ destructor TArraySwapExpr.Destroy;
//
procedure TArraySwapExpr.EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray);
var
i1, i2 : Integer;
i1, i2 : Int64;
begin
BaseExpr.EvalAsScriptDynArray(exec, result);
i1 := Index1Expr.EvalAsInteger(exec);
Expand Down Expand Up @@ -3057,7 +3060,7 @@ destructor TArrayDeleteExpr.Destroy;
procedure TArrayDeleteExpr.EvalNoResult(exec : TdwsExecution);
var
base : IScriptDynArray;
index, count : Integer;
index, count : Int64;
begin
BaseExpr.EvalAsScriptDynArray(exec, base);

Expand Down Expand Up @@ -3132,7 +3135,7 @@ procedure TArrayCopyExpr.EvalAsVariant(exec : TdwsExecution; var Result : Varian
procedure TArrayCopyExpr.EvalAsScriptDynArray(exec : TdwsExecution; var result : IScriptDynArray);
var
base : IScriptDynArray;
index, count : Integer;
index, count : Int64;
begin
BaseExpr.EvalAsScriptDynArray(exec, base);
if IndexExpr <> nil then begin
Expand Down Expand Up @@ -3197,7 +3200,8 @@ destructor TArrayInsertExpr.Destroy;
procedure TArrayInsertExpr.EvalNoResult(exec : TdwsExecution);
var
base : IScriptDynArray;
n, index, elemSize : Integer;
n, index : Int64;
elemSize : Integer;
buf : Variant;
begin
BaseExpr.EvalAsScriptDynArray(exec, base);
Expand Down Expand Up @@ -3268,7 +3272,7 @@ destructor TArrayMoveExpr.Destroy;
procedure TArrayMoveExpr.EvalNoResult(exec : TdwsExecution);
var
base : IScriptDynArray;
indexOrigin, indexDest : Integer;
indexOrigin, indexDest : Int64;
begin
BaseExpr.EvalAsScriptDynArray(exec, base);

Expand Down
12 changes: 6 additions & 6 deletions Source/dwsExprs.pas
Original file line number Diff line number Diff line change
Expand Up @@ -709,9 +709,9 @@ TProgramExpr = class(TExprBase)
procedure AssignValueAsScriptObj(exec : TdwsExecution; const value : IScriptObj); override;
procedure AssignValueAsScriptDynArray(exec : TdwsExecution; const value : IScriptDynArray); override;

procedure RaiseUpperExceeded(exec : TdwsExecution; index : Integer);
procedure RaiseLowerExceeded(exec : TdwsExecution; index : Integer);
procedure BoundsCheckFailed(exec : TdwsExecution; index : Integer);
procedure RaiseUpperExceeded(exec : TdwsExecution; index : Int64);
procedure RaiseLowerExceeded(exec : TdwsExecution; index : Int64);
procedure BoundsCheckFailed(exec : TdwsExecution; index : Int64);

procedure CheckScriptObject(exec : TdwsExecution; const scriptObj : IScriptObj);

Expand Down Expand Up @@ -3948,21 +3948,21 @@ procedure TProgramExpr.EvalAsUnicodeString(exec : TdwsExecution; var result : Un

// RaiseUpperExceeded
//
procedure TProgramExpr.RaiseUpperExceeded(exec : TdwsExecution; index : Integer);
procedure TProgramExpr.RaiseUpperExceeded(exec : TdwsExecution; index : Int64);
begin
RaiseScriptError(exec, EScriptOutOfBounds.CreateFmt(RTE_ArrayUpperBoundExceeded, [index]));
end;

// RaiseLowerExceeded
//
procedure TProgramExpr.RaiseLowerExceeded(exec : TdwsExecution; index : Integer);
procedure TProgramExpr.RaiseLowerExceeded(exec : TdwsExecution; index : Int64);
begin
RaiseScriptError(exec, EScriptOutOfBounds.CreateFmt(RTE_ArrayLowerBoundExceeded, [index]));
end;

// BoundsCheckFailed
//
procedure TProgramExpr.BoundsCheckFailed(exec : TdwsExecution; index : Integer);
procedure TProgramExpr.BoundsCheckFailed(exec : TdwsExecution; index : Int64);
begin
if index < 0 then
RaiseLowerExceeded(exec, index)
Expand Down
51 changes: 51 additions & 0 deletions Test/ArrayPass/array_bounds_int64.pas
Original file line number Diff line number Diff line change
Expand Up @@ -48,3 +48,54 @@ function MakeArr : array of Integer;
end;

PrintLn(a[2]);

var d : array of Integer;
d.SetLength(5);
for var i := 0 to 4 do
d[i] := 200 + i;

try
d[base + 1] := 999;
PrintLn('FAIL no exception on dynamic write (d[2^32 + 1])');
except
on E: Exception do PrintLn('OK out-of-bounds raised on dynamic write');
end;

PrintLn(d[1]);

try
d.Delete(base);
PrintLn('FAIL no exception (d.Delete(2^32))');
except
on E: Exception do PrintLn('OK out-of-bounds raised for Delete');
end;

try
d.Insert(base, 1);
PrintLn('FAIL no exception (d.Insert(2^32))');
except
on E: Exception do PrintLn('OK out-of-bounds raised for Insert');
end;

try
d.Swap(base, 1);
PrintLn('FAIL no exception (d.Swap(2^32, 1))');
except
on E: Exception do PrintLn('OK out-of-bounds raised for Swap');
end;

try
d.Move(base, 1);
PrintLn('FAIL no exception (d.Move(2^32, 1))');
except
on E: Exception do PrintLn('OK out-of-bounds raised for Move');
end;

try
PrintLn(d.Copy(base, 1).Length);
PrintLn('FAIL no exception (d.Copy(2^32, 1))');
except
on E: Exception do PrintLn('OK out-of-bounds raised for Copy');
end;

PrintLn(d.Length);
8 changes: 8 additions & 0 deletions Test/ArrayPass/array_bounds_int64.txt
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,11 @@ OK out-of-bounds raised for 2^32
OK out-of-bounds raised for 2^32 + 3
OK out-of-bounds raised on write
102
OK out-of-bounds raised on dynamic write
201
OK out-of-bounds raised for Delete
OK out-of-bounds raised for Insert
OK out-of-bounds raised for Swap
OK out-of-bounds raised for Move
OK out-of-bounds raised for Copy
5