paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 01:59:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: check error in expressions, when new dbg-values are created.

Browse Source
This commit is contained in:
Martin 2023-12-02 16:19:58 +01:00
parent c398363932
commit 53474705c4
5 changed files with 98 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpdebug/fpdbginfo.pas
View File

@ -119,8 +119,6 @@ type
FSize: TFpDbgValueSize;
procedure SetAsString(AStartIndex, ALen: Int64; AValue: AnsiString);
protected
procedure SetLastError(ALastError: TFpError);
function GetKind: TDbgSymbolKind; virtual;
function GetFieldFlags: TFpValueFieldFlags; virtual;
@ -243,6 +241,7 @@ type
property ParentTypeInfo: TFpSymbol read GetParentTypeInfo; // For members, the class in which this member is declared
property LastError: TFpError read GetLastError;
procedure SetLastError(ALastError: TFpError);
procedure ResetError;
end;

63
components/fpdebug/fppascalparser.pas
View File

@ -814,6 +814,16 @@ begin
Result := '?';
end;
procedure ForwardError(ATarget, ASrc: TFpValue); inline;
begin
if (ATarget = nil) or (ASrc = nil) then
exit;
if not IsError(ATarget.LastError) and
IsError(ASrc.LastError)
then
ATarget.SetLastError(ASrc.LastError);
end;
procedure TFpPascalExpressionPartList.Clear;
begin
assert(False, 'TFpPascalExpressionPartList.Clear: False');
@ -4013,6 +4023,7 @@ begin
end;
{$POP}
ForwardError(Result, tmp1);
end;
{ TFpPascalExpressionPartOperatorPlusMinus }
@ -4279,6 +4290,8 @@ begin
Result := SubtractSets(tmp1, tmp2);
end;
end;
ForwardError(Result, tmp1);
ForwardError(Result, tmp2);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then
Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
@ -4388,6 +4401,13 @@ function TFpPascalExpressionPartOperatorMulDiv.DoGetResultValue: TFpValue;
function NumDivIntByValue(AIntVal, AOtherVal: TFpValue): TFpValue;
begin
Result := nil;
if (AOtherVal.AsInteger = 0) then begin
if (IsError(AOtherVal.LastError)) then
Result := TFpValueConstNumber.Create(0) // just for the error
else
SetError('Division by zero');
end
else
case AOtherVal.Kind of
skInteger: Result := TFpValueConstNumber.Create(AIntVal.AsInteger div AOtherVal.AsInteger, True);
skCardinal: Result := TFpValueConstNumber.Create(AIntVal.AsInteger div AOtherVal.AsCardinal, True);
@ -4397,6 +4417,13 @@ function TFpPascalExpressionPartOperatorMulDiv.DoGetResultValue: TFpValue;
function NumDivCardinalByValue(ACardinalVal, AOtherVal: TFpValue): TFpValue;
begin
Result := nil;
if (AOtherVal.AsInteger = 0) then begin
if (IsError(AOtherVal.LastError)) then
Result := TFpValueConstNumber.Create(0) // just for the error
else
SetError('Division by zero');
end
else
case AOtherVal.Kind of
skInteger: Result := TFpValueConstNumber.Create(ACardinalVal.AsCardinal div AOtherVal.AsInteger, True);
skCardinal: Result := TFpValueConstNumber.Create(ACardinalVal.AsCardinal div AOtherVal.AsCardinal, False);
@ -4407,6 +4434,13 @@ function TFpPascalExpressionPartOperatorMulDiv.DoGetResultValue: TFpValue;
function NumModIntByValue(AIntVal, AOtherVal: TFpValue): TFpValue;
begin
Result := nil;
if (AOtherVal.AsInteger = 0) then begin
if (IsError(AOtherVal.LastError)) then
Result := TFpValueConstNumber.Create(0) // just for the error
else
SetError('Modulo by zero')
end
else
case AOtherVal.Kind of
skInteger: Result := TFpValueConstNumber.Create(AIntVal.AsInteger mod AOtherVal.AsInteger, True);
skCardinal: Result := TFpValueConstNumber.Create(AIntVal.AsInteger mod AOtherVal.AsCardinal, True);
@ -4416,6 +4450,13 @@ function TFpPascalExpressionPartOperatorMulDiv.DoGetResultValue: TFpValue;
function NumModCardinalByValue(ACardinalVal, AOtherVal: TFpValue): TFpValue;
begin
Result := nil;
if (AOtherVal.AsInteger = 0) then begin
if (IsError(AOtherVal.LastError)) then
Result := TFpValueConstNumber.Create(0) // just for the error
else
SetError('Modulo by zero')
end
else
case AOtherVal.Kind of
skInteger: Result := TFpValueConstNumber.Create(ACardinalVal.AsCardinal mod AOtherVal.AsInteger, True);
skCardinal: Result := TFpValueConstNumber.Create(ACardinalVal.AsCardinal mod AOtherVal.AsCardinal, False);
@ -4464,6 +4505,9 @@ begin
end;
end;
ForwardError(Result, tmp1);
ForwardError(Result, tmp2);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then
Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4493,6 +4537,7 @@ begin
skBoolean: Result := TFpValueConstBool.Create(not tmp1.AsBool);
end;
{$POP}
ForwardError(Result, tmp1);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4525,9 +4570,13 @@ begin
skCardinal: if tmp2.Kind in [skInteger, skCardinal] then
Result := TFpValueConstNumber.Create(tmp1.AsCardinal AND tmp2.AsCardinal, False);
skBoolean: if tmp2.Kind = skBoolean then
{$PUSH}{$BOOLEVAL on}
Result := TFpValueConstBool.Create(tmp1.AsBool AND tmp2.AsBool);
{$POP}
end;
{$POP}
ForwardError(Result, tmp1);
ForwardError(Result, tmp2);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4585,6 +4634,9 @@ begin
Result := TFpValueConstNumber.Create(AVal >> AShift, False);
{$POP}
ForwardError(Result, Items[0].ResultValue);
ForwardError(Result, Items[1].ResultValue);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4602,6 +4654,9 @@ begin
Result := TFpValueConstNumber.Create(AVal << AShift, False);
{$POP}
ForwardError(Result, Items[0].ResultValue);
ForwardError(Result, Items[1].ResultValue);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4636,7 +4691,9 @@ begin
if tmp2.Kind = skCardinal then
Result := TFpValueConstNumber.Create(tmp1.AsInteger OR tmp2.AsInteger, False);
skBoolean: if tmp2.Kind = skBoolean then
{$PUSH}{$BOOLEVAL on}
Result := TFpValueConstBool.Create(tmp1.AsBool OR tmp2.AsBool);
{$POP}
end;
ootXor:
case tmp1.Kind of
@ -4648,10 +4705,14 @@ begin
if tmp2.Kind = skCardinal then
Result := TFpValueConstNumber.Create(tmp1.AsInteger XOR tmp2.AsInteger, False);
skBoolean: if tmp2.Kind = skBoolean then
{$PUSH}{$BOOLEVAL on}
Result := TFpValueConstBool.Create(tmp1.AsBool XOR tmp2.AsBool);
{$POP}
end;
end;
{$POP}
ForwardError(Result, tmp1);
ForwardError(Result, tmp2);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;
@ -4955,6 +5016,8 @@ begin
Result := SymDiffSets(tmp1, tmp2);
end;
ForwardError(Result, tmp1);
ForwardError(Result, tmp2);
{$IFDEF WITH_REFCOUNT_DEBUG}if Result <> nil then
Result.DbgRenameReference(nil, 'DoGetResultValue');{$ENDIF}
end;

4
components/fpdebug/fpwatchresultdata.pas
View File

@ -978,8 +978,10 @@ begin
AnResData.CreateError('No Data');
exit;
end;
if CheckError(AnFpValue, AnResData) then
if CheckError(AnFpValue, AnResData) then begin
Result := True;
exit;
end;
FRecurseAddrList.Clear;
FRepeatCount := ARepeatCount;

24
components/lazdebuggers/lazdebuggerfp/test/testwatches.pas
View File

@ -4280,7 +4280,7 @@ end;
procedure TTestWatches.TestWatchesErrors;
var
ExeName: String;
ExeName, op1, op2: String;
t: TWatchExpectationList;
Src: TCommonSource;
BrkPrg: TDBGBreakPoint;
@ -4325,6 +4325,28 @@ begin
t.Add('', 'gvIntStatArray^', weMatchFpErr(LazErrCannotDeref_p));
t.Add('', '^byte(''abc'')^', weMatchErr('.'));
for op1 in [' ', '+','-'] do
for op2 in [' + ',' - ', ' * ', ' / ', ' = ', ' div ', ' mod ', ' and ', ' or ', ' xor '] do
begin
t.Add('', op1+'^byte(0)^', weMatchErr('read.*mem|data.*location')); // TODO: wrong error
t.Add('', op1+'^byte(0)^'+op2+'2', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'2'+op2+'^byte(0)^', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'^byte(1)^', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'^byte(1)^'+op2+'2', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'2'+op2+'^byte(1)^', weMatchErr('read.*mem|data.*location|div.*zero|mod.*zero'));
end;
for op1 in [' ', 'not '] do
for op2 in [' = ', ' and ', ' or ', ' xor '] do
begin
t.Add('', op1+'^boolean(0)^', weMatchErr('read.*mem|data.*location|data.*location')); // TODO: wrong error
t.Add('', op1+'^boolean(0)^'+op2+'True', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'True'+op2+'^boolean(0)^', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'^boolean(1)^', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'^boolean(1)^'+op2+'True', weMatchErr('read.*mem|data.*location'));
t.Add('', op1+'True'+op2+'^boolean(1)^', weMatchErr('read.*mem|data.*location'));
end;
t.EvaluateWatches;
t.CheckResults;

10
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -1492,11 +1492,17 @@ begin
if ehExpectError in ehf then begin
//TODO
Result := TestTrue('TstWatch.value is NOT valid', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
if Context.WatchRes.ValueKind = rdkError then
Result := TestTrue('IsErr', Context.WatchRes.ValueKind = rdkError, Context, AnIgnoreRsn)
else
Result := TestTrue('TstWatch.value is NOT valid', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
exit;
end;
if ehExpectErrorText in ehf then begin
Result := TestTrue('TstWatch.value is NOT valid', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
if Context.WatchRes.ValueKind = rdkError then
Result := TestTrue('IsErr', Context.WatchRes.ValueKind = rdkError, Context, AnIgnoreRsn)
else
Result := TestTrue('TstWatch.value is NOT valid', WatchVal.Validity in [ddsError, ddsInvalid], Context, AnIgnoreRsn);
Result := CheckData(Context, AnIgnoreRsn, True, True);
exit;
end;