pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Improve prev commit. Fix math formulas with non-numeric strings not returning result #VALUE! Add unit tests for this.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6570 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-08-05 13:35:25 +00:00
parent a261ff7999
commit d71884f3e2
5 changed files with 282 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

232
components/fpspreadsheet/source/common/fpsexprparser.pas
View File

@ -294,56 +294,7 @@ type
destructor Destroy; override;
property Operand: TsExprNode read FOperand;
end;
(*
{ TsNotExprNode }
TsNotExprNode = class(TsUnaryOperationExprNode)
protected
procedure GetNodeValue(out AResult: TsExpressionResult); override;
public
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override;
procedure Check; override;
function NodeType: TsResultType; override;
end;
*)
(*
{ TsConvertExprNode }
TsConvertExprNode = class(TsUnaryOperationExprNode)
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function AsString: String; override;
end;
{ TsConvertToIntExprNode }
TsConvertToIntExprNode = class(TsConvertExprNode)
public
// procedure Check; override;
end;
{ TsIntToFloatExprNode }
TsIntToFloatExprNode = class(TsConvertToIntExprNode)
protected
procedure GetNodeValue(out Result: TsExpressionResult); override;
public
function NodeType: TsResultType; override;
end;
{ TsIntToDateTimeExprNode }
TsIntToDateTimeExprNode = class(TsConvertToIntExprNode)
protected
procedure GetNodeValue(out Result: TsExpressionResult); override;
public
function NodeType: TsResultType; override;
end;
{ TsFloatToDateTimeExprNode }
TsFloatToDateTimeExprNode = class(TsConvertExprNode)
protected
procedure GetNodeValue(out Result: TsExpressionResult); override;
public
// procedure Check; override;
function NodeType: TsResultType; override;
end;
*)
{ TsUPlusExprNode }
TsUPlusExprNode = class(TsUnaryOperationExprNode)
protected
@ -3069,6 +3020,7 @@ end;
procedure TsUMinusExprNode.GetNodeValue(out Result: TsExpressionResult);
var
cell: PCell;
val: Extended;
begin
Operand.GetNodeValue(Result);
case Result.ResultType of
@ -3081,17 +3033,31 @@ begin
rtCell:
begin
cell := ArgToCell(Result);
if (cell <> nil) and (cell^.ContentType = cctNumber) then
if cell = nil then
Result := FloatResult(0.0)
else if (cell^.ContentType = cctUTF8String) then begin
if TryStrToFloat(cell^.UTF8StringValue, val) then
Result := FloatResult(-val)
else
Result := ErrorResult(errWrongType);
end else
if (cell^.ContentType = cctNumber) or (cell^.ContentType = cctDateTime) then
begin
if frac(cell^.NumberValue) = 0.0 then
Result := IntegerResult(-trunc(cell^.NumberValue))
else
Result := FloatResult(cell^.NumberValue);
end else
Result := FloatResult(0.0);
if (cell^.ContentType = cctBool) then
Result := ErrorResult(errWrongType);
end;
rtEmpty:
Result := FloatResult(0.0);
rtString:
if TryStrToFloat(Result.ResString, val) then
Result := FloatResult(-val)
else
Result := ErrorResult(errWrongType);
else
Result := ErrorResult(errWrongType);
end;
@ -3237,6 +3203,7 @@ end;
procedure TsEqualExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
@ -3252,8 +3219,14 @@ begin
if IsString(LRes) and IsString(RRes) then
AResult := BooleanResult(ArgToString(LRes) = ArgToString(RRes))
else
AResult := BooleanResult(ArgToFloat(LRes) = ArgToFloat(RRes));
else begin
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := BooleanResult(false)
else
AResult := BooleanResult(fL = fR);
end;
end;
@ -3300,6 +3273,7 @@ end;
procedure TsLessExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3309,8 +3283,14 @@ begin
if IsString(LRes) and IsString(RRes) then
AResult := BooleanResult(ArgToString(LRes) < ArgToString(RRes))
else
AResult := BooleanResult(ArgToFloat(LRes) < ArgToFloat(RRes));
else begin
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := BooleanResult(false)
else
AResult := BooleanResult(fL < fR);
end;
end;
@ -3333,6 +3313,7 @@ end;
procedure TsGreaterExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3342,8 +3323,14 @@ begin
if IsString(LRes) and IsString(RRes) then
AResult := BooleanResult(ArgToString(LRes) > ArgToString(RRes))
else
AResult := BooleanResult(ArgToFloat(LRes) > ArgToFloat(RRes));
else begin
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := BooleanResult(false)
else
AResult := BooleanResult(fL > fR);
end;
end;
@ -3366,6 +3353,7 @@ end;
procedure TsGreaterEqualExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3375,8 +3363,14 @@ begin
if IsString(LRes) and IsString(RRes) then
AResult := BooleanResult(ArgToString(LRes) >= ArgToString(RRes))
else
AResult := BooleanResult(ArgToFloat(LRes) >= ArgToFloat(RRes));
else begin
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := BooleanResult (false)
else
AResult := BooleanResult(fL >= fR);
end;
end;
@ -3399,6 +3393,7 @@ end;
procedure TsLessEqualExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3408,8 +3403,14 @@ begin
if IsString(LRes) and IsString(RRes) then
AResult := BooleanResult(ArgToString(LRes) <= ArgToString(RRes))
else
AResult := BooleanResult(ArgToFloat(LRes) <= ArgToFloat(RRes));
else begin
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := BooleanResult (false)
else
AResult := BooleanResult(fL <= fR);
end;
end;
@ -3474,6 +3475,7 @@ end;
procedure TsAddExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3481,10 +3483,12 @@ begin
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
if IsInteger(LRes) and IsInteger(RRes) then
AResult := IntegerResult(ArgToInt(LRes) + ArgToInt(RRes))
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := ErrorResult(errWrongType)
else
AResult := FloatResult(ArgToFloat(LRes) + ArgToFloat(RRes));
AResult := FloatResult(fL + fR);
end;
@ -3507,6 +3511,7 @@ end;
procedure TsSubtractExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
lRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3514,11 +3519,12 @@ begin
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
if IsInteger(LRes) and IsInteger(RRes)
then
AResult := IntegerResult(ArgToInt(LRes) - ArgToInt(RRes))
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := ErrorResult(errWrongType)
else
AResult := FloatResult(ArgToFloat(LRes) - ArgToFloat(RRes))
AResult := FloatResult(fL - fR);
end;
@ -3541,14 +3547,20 @@ end;
procedure TsMultiplyExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
try
AResult := FloatResult(ArgToFloat(LRes) * ArgToFloat(RRes));
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := ErrorResult(errWrongType)
else
try
AResult := FloatResult(fL * fR);
except
on EInvalidArgument do AResult := ErrorResult(errOverflow);
end;
@ -3574,7 +3586,7 @@ end;
procedure TsDivideExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
y: TsExprFloat;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
@ -3582,12 +3594,16 @@ begin
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
y := ArgToFloat(RRes);
if y = 0.0 then
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := ErrorResult(errWrongType)
else
if fR = 0.0 then
AResult := ErrorResult(errDivideByZero)
else
try
AResult := FloatResult(ArgToFloat(LRes) / y);
AResult := FloatResult(fL / fR);
except
on EInvalidArgument do AResult := ErrorResult(errOverflow);
end;
@ -3618,17 +3634,23 @@ end;
procedure TsPowerExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes: TsExpressionResult;
fL, fR: TsExprFloat;
begin
if HasError(AResult) then
exit;
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
try
AResult := FloatResult(Power(ArgToFloat(LRes), ArgToFloat(RRes)));
except
on E: EInvalidArgument do AResult := ErrorResult(errOverflow);
end;
fL := ArgToFloat(LRes);
fR := ArgToFloat(RRes);
if IsNaN(fL) or IsNaN(fR) then
AResult := ErrorResult(errWrongType)
else
try
AResult := FloatResult(Power(fL, fR));
except
on E: EInvalidArgument do AResult := ErrorResult(errOverflow);
end;
end;
function TsPowerExprNode.NodeType: TsResultType;
@ -3766,21 +3788,6 @@ begin
if rta = rtCell then
Continue;
(*
if (rtp <> rta) and not (rta in [rtCellRange, rtError, rtEmpty]) then
begin
// Automatically convert integers to floats in functions that return a float
if (rta = rtInteger) and (rtp = rtFloat) then
begin
FArgumentNodes[i] := TsIntToFloatExprNode(FArgumentNodes[i]);
exit;
end;
// Floats are truncated automatically to integers - that's what Excel does.
if (rta = rtFloat) and (rtp = rtInteger) then
exit;
RaiseParserError(SErrInvalidArgumentType, [i+1, ResultTypeName(rtp), ResultTypeName(rta)])
end;
*)
end;
end;
@ -3978,30 +3985,6 @@ begin
AResult.Worksheet := GetSheet;
end;
(*
procedure TsCellExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
cell: PCell;
begin
if Parser.CopyMode then
cell := (FWorksheet as TsWorksheet).FindCell(GetRow, GetCol)
else
cell := FCell;
if (cell <> nil) and HasFormula(cell) then
case (FWorksheet as TsWorksheet).GetCalcState(cell) of
csNotCalculated:
(FWorksheet as TsWorksheet).CalcFormula(cell);
csCalculating:
raise ECalcEngine.CreateFmt(rsCircularReference, [GetCellString(cell^.Row, cell^.Col)]);
end;
AResult.ResultType := rtCell;
AResult.ResRow := GetRow;
AResult.ResCol := GetCol;
AResult.Worksheet := GetSheet;
end;
*)
{ See: GetCol }
function TsCellExprNode.GetRow: Cardinal;
@ -4223,7 +4206,7 @@ end;
procedure TsCellRangeExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
r, c, s: Array[TsCellRangeIndex] of Cardinal;
r, c, s: Array[TsCellRangeIndex] of Integer; //Cardinal;
ss: Integer;
i: TsCellRangeIndex;
sheet: TsWorksheet;
@ -4427,7 +4410,8 @@ begin
begin
fs := (Arg.Worksheet as TsWorksheet).Workbook.FormatSettings;
s := cell^.UTF8StringValue;
TryStrToFloat(s, result, fs);
if not TryStrToFloat(s, Result, fs) then
Result := NaN;
end;
end;
end;
@ -4601,8 +4585,12 @@ end;
function FloatResult(const AValue: TsExprFloat): TsExpressionResult;
begin
Result.ResultType := rtFloat;
Result.ResFloat := AValue;
if IsNaN(AValue) then
Result := ErrorResult(errWrongType)
else begin
Result.ResultType := rtFloat;
Result.ResFloat := AValue;
end;
end;
function IntegerResult(const AValue: Integer): TsExpressionResult;

9
components/fpspreadsheet/source/common/fpspreadsheet.pas
View File

@ -5208,15 +5208,16 @@ begin
// "1" as a valid date/time.
if TryStrToDateTime(AValue, number, AFormatSettings) then
begin
if (number < 1.0) or IsTimeFormat(numFmtParams) then // this is a time alone
if number < 1.0 then // this is a time alone
begin
// if not IsTimeFormat(numFmtParams) then
// begin
if not IsTimeFormat(numFmtParams) then
begin
ucValue := Uppercase(AValue);
isAMPM := (pos('AM', ucValue) > 0) or (pos('PM', ucValue) > 0);
isLongTime := IsLongTimeFormat(AValue, AFormatSettings.TimeSeparator);
WriteDateTime(ACell, number, TIME_FMT[isAMPM, isLongTime]);
// end;
end else
WriteDateTime(ACell, number);
end else
if frac(number) = 0.0 then // this is a date alone
begin

4
components/fpspreadsheet/tests/formulatests.pas
View File

@ -38,6 +38,7 @@ type
procedure Test_Write_Read_CalcFormulas(AFormat: TsSpreadsheetformat;
UseRPNFormula: Boolean);
procedure Test_Write_Read_Calc3DFormulas(AFormat: TsSpreadsheetFormat);
procedure Test_OverwriteFormulaTest(ATest: Integer; AFormat: TsSpreadsheetFormat);
published
@ -108,6 +109,7 @@ type
procedure Test_OverwriteFormula_Error_BIFF8;
procedure Test_OverwriteFormula_Error_OOXML;
procedure Test_OverwriteFormula_Error_ODS;
end;
implementation
@ -1066,8 +1068,6 @@ begin
end;
initialization
// Register so these tests are included in a full run
RegisterTest(TSpreadWriteReadFormulaTests);

2
components/fpspreadsheet/tests/internaltests.pas
View File

@ -798,7 +798,7 @@ type
THtmlRichTextParam = record
HTML: String;
PlainText: String;
NumRichTextParams: 0..1;
NumRichTextParams: 0..2;
RichTextParams: array[0..1] of TsRichTextParam;
end;

165
components/fpspreadsheet/tests/singleformulatests.pas
View File

@ -27,6 +27,7 @@ type
ATestKind: TFormulaTestKind; AFormat: TsSpreadsheetFormat;
AExpectedFormula: String = '');
procedure TestWorksheet(ATestKind: TWorksheetTestKind; ATestCase: Integer);
procedure TestFormulaErrors(ATest: Integer);
published
procedure AddConst_BIFF2;
@ -113,6 +114,25 @@ type
procedure DeleteWorksheet_Multi_KeepFirst;
procedure DeleteWorksheet_Multi_All;
procedure Error_AddStringNumber;
procedure Error_SubtractStringNumber;
procedure Error_MultiplyStringNumber;
procedure Error_DivideStringNumber;
procedure Error_PowerStringNumber;
procedure Error_SinString;
procedure Error_SinStringAddNumber;
procedure Error_Equal;
procedure Error_NotEqual;
procedure Error_Greater;
procedure Error_Smaller;
procedure Error_GreaterEqual;
procedure Error_LessEqual;
procedure Error_UnaryPlusString;
procedure Error_UnaryMinusString;
procedure Add_Number_NumString;
procedure Equal_Number_NumString;
procedure UnaryMinusNumString;
end;
implementation
@ -121,7 +141,8 @@ uses
{$IFDEF FORMULADEBUG}
LazLogger,
{$ENDIF}
Math, typinfo, lazUTF8, fpsUtils;
//Math,
typinfo, lazUTF8, fpsUtils;
{ TSpreadExtendedFormulaTests }
@ -851,6 +872,148 @@ begin
end;
{ Formula errors }
procedure TSpreadSingleFormulaTests.TestFormulaErrors(ATest: Integer);
type
TTestCase = record
Formula: string;
Expected: String;
end;
const
// Cell A1 is 'abc' (string), A2 is 1.0 (number), A3 is '1' (string)
TestCases: array[0..17] of TTestCase = (
{0} (Formula: 'A1+A2'; Expected: '#VALUE!'),
(Formula: 'A1-A2'; Expected: '#VALUE!'),
(Formula: 'A1*A2'; Expected: '#VALUE!'),
(Formula: 'A1/A2'; Expected: '#VALUE!'),
(Formula: 'A1^A2'; Expected: '#VALUE!'),
{5} (Formula: 'sin(A1)'; Expected: '#VALUE!'),
(Formula: 'sin(A1)+A2'; Expected: '#VALUE!'),
(Formula: 'A1=A2'; Expected: 'FALSE'),
(Formula: 'A1<>A2'; Expected: 'TRUE'),
(Formula: 'A1>A2'; Expected: 'FALSE'),
{10} (Formula: 'A1<A2'; Expected: 'FALSE'),
(Formula: 'A1>=A2'; Expected: 'FALSE'),
(Formula: 'A1<=A2'; Expected: 'FALSE'),
(Formula: '+A1'; Expected: 'abc'),
(Formula: '-A1'; Expected: '#VALUE!'),
{15} (Formula: 'A2+A3'; Expected: '2'),
(Formula: 'A2=A3'; Expected: 'TRUE'),
(Formula: '-A3'; Expected: '-1')
);
var
book: TsWorkbook;
sheet: TsWorksheet;
s: String;
begin
book := TsWorkbook.Create;
try
book.Options := book.Options + [boAutoCalc];
sheet := book.AddWorksheet('Test');
sheet.WriteText(0, 0, 'abc'); // A1 = 'abc'
sheet.WriteNumber(1, 0, 1.0); // A2 = 1.0
sheet.WriteText(2, 0, '1'); // A2 = '1';
sheet.WriteFormula(0, 1, TestCases[ATest].Formula);
s := sheet.ReadAsText(0, 1);
CheckEquals(TestCases[ATest].Expected, s, 'Error value match, formula "' + sheet.ReadFormula(0, 1) + '"');
finally
book.Free;
end;
end;
procedure TSpreadSingleFormulaTests.Error_AddStringNumber;
begin
TestFormulaErrors(0);
end;
procedure TSpreadSingleFormulaTests.Error_SubtractStringNumber;
begin
TestFormulaErrors(1);
end;
procedure TSpreadSingleFormulaTests.Error_MultiplyStringNumber;
begin
TestFormulaErrors(2);
end;
procedure TSpreadSingleFormulaTests.Error_DivideStringNumber;
begin
TestFormulaErrors(3);
end;
procedure TSpreadSingleFormulaTests.Error_PowerStringNumber;
begin
TestFormulaErrors(4);
end;
procedure TSpreadSingleFormulaTests.Error_SinString;
begin
TestFormulaErrors(5);
end;
procedure TSpreadSingleFormulaTests.Error_SinStringAddNumber;
begin
TestFormulaErrors(6);
end;
procedure TSpreadSingleFormulaTests.Error_Equal;
begin
TestFormulaErrors(7);
end;
procedure TSpreadSingleFormulaTests.Error_NotEqual;
begin
TestFormulaErrors(8);
end;
procedure TSpreadSingleFormulaTests.Error_Greater;
begin
TestFormulaErrors(9);
end;
procedure TSpreadSingleFormulaTests.Error_Smaller;
begin
TestFormulaErrors(10);
end;
procedure TSpreadSingleFormulaTests.Error_GreaterEqual;
begin
TestFormulaErrors(11);
end;
procedure TSpreadSingleFormulaTests.Error_LessEqual;
begin
TestFormulaErrors(12);
end;
procedure TSpreadSingleFormulaTests.Error_UnaryPlusString;
begin
TestFormulaErrors(13);
end;
procedure TSpreadSingleFormulaTests.Error_UnaryMinusString;
begin
TestFormulaErrors(14);
end;
procedure TSpreadSingleFormulaTests.Add_Number_NumString;
begin
TestFormulaErrors(15);
end;
procedure TSpreadSingleFormulaTests.Equal_Number_NumString;
begin
TestFormulaErrors(16);
end;
procedure TSpreadSingleFormulaTests.UnaryMinusNumString;
begin
TestFormulaErrors(17);
end;
initialization
// Register to include these tests in a full run
RegisterTest(TSpreadSingleFormulaTests);