diff --git a/components/fpspreadsheet/source/common/fpsexprparser.pas b/components/fpspreadsheet/source/common/fpsexprparser.pas index f6c4d1c05..ef6062ba8 100644 --- a/components/fpspreadsheet/source/common/fpsexprparser.pas +++ b/components/fpspreadsheet/source/common/fpsexprparser.pas @@ -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; diff --git a/components/fpspreadsheet/source/common/fpspreadsheet.pas b/components/fpspreadsheet/source/common/fpspreadsheet.pas index 894d82fde..45c1a5c7f 100644 --- a/components/fpspreadsheet/source/common/fpspreadsheet.pas +++ b/components/fpspreadsheet/source/common/fpspreadsheet.pas @@ -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 diff --git a/components/fpspreadsheet/tests/formulatests.pas b/components/fpspreadsheet/tests/formulatests.pas index e792484b1..2bfae4f75 100644 --- a/components/fpspreadsheet/tests/formulatests.pas +++ b/components/fpspreadsheet/tests/formulatests.pas @@ -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); diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index fba6c95be..1b23177cd 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -798,7 +798,7 @@ type THtmlRichTextParam = record HTML: String; PlainText: String; - NumRichTextParams: 0..1; + NumRichTextParams: 0..2; RichTextParams: array[0..1] of TsRichTextParam; end; diff --git a/components/fpspreadsheet/tests/singleformulatests.pas b/components/fpspreadsheet/tests/singleformulatests.pas index 9f88dace9..e79d0f28e 100644 --- a/components/fpspreadsheet/tests/singleformulatests.pas +++ b/components/fpspreadsheet/tests/singleformulatests.pas @@ -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'; 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);