paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

FPSpreadsheet: Fix misc bugs in INDEX and INDIRECT formulas.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9646 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2025-02-25 10:49:55 +00:00
parent cadf2d517a
commit 960402692f
4 changed files with 82 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3275,6 +3275,7 @@ begin
AResult.Worksheet := FParser.FWorksheet;
AResult.ResRow := FParser.FRow;
AResult.ResCol := FParser.FCol;
AResult.ResSheetName := FParser.Worksheet.Name;
AResult.Parser := FParser;
end;
@ -3793,15 +3794,15 @@ end;
procedure TsConcatExprNode.GetNodeValue(out AResult: TsExpressionResult);
var
LRes, RRes : TsExpressionResult;
LRes, RRes: TsExpressionResult;
LStr, RStr: String;
begin
if not GetLeftRightValues(LRes, RRes, AResult) then
exit;
Left.GetNodeValue(LRes);
Right.GetNodeValue(RRes);
AResult := StringResult(ArgToString(LRes) + ArgToString(RRes));
LStr := ArgToString(LRes);
RStr := ArgToString(RRes);
AResult := StringResult(LStr + RStr);
AResult.Parser := FParser;
end;
@ -4892,9 +4893,21 @@ begin
end;
function ArgToCell(Arg: TsExpressionResult): PCell;
var
book: TsWorkbook;
sheet: TsWorksheet;
begin
if Arg.ResultType = rtCell then
Result := (Arg.Worksheet as TsWorksheet).FindCell(Arg.ResRow, Arg.ResCol)
begin
sheet := Arg.Worksheet as TsWorksheet;
if Arg.ResSheetName <> '' then
begin
book := sheet.Workbook;
sheet := book.GetWorksheetByName(Arg.ResSheetName);
end;
Result := sheet.FindCell(Arg.ResRow, Arg.ResCol)
end
// Result := (Arg.Worksheet as TsWorksheet).FindCell(Arg.ResRow, Arg.ResCol)
else
Result := nil;
end;

43
components/fpspreadsheet/source/common/fpsfunc.pas
View File

@ -364,7 +364,7 @@ begin
// as the criteria cell we have extracted a criteria value.
// Since a match had been found before the formula must use the
// error value as search criterion.
if IsNaN(val) and (FValueRangeIndex = FCriteriaRangeIndex) then
if IsNaN(val) and (FValueRangeIndex = FCriteriaRangeIndex) and (FCompareType = ctError) then
begin;
val := 1;
FError := errOK;
@ -3302,6 +3302,12 @@ end;
NOTE: ref_style and mixing of A1 and R1C1 notation is not supported. }
procedure fpsINDIRECT(var Result: TsExpressionResult;
const Args: TsExprParameterArray);
var
arg: TsExpressionResult;
argStr, arg0Str: String;
sh1, sh2: String;
r1, c1, r2, c2: Cardinal;
flags: TsRelFlags;
begin
if IsError(Args[0], Result) then
exit;
@ -3310,30 +3316,35 @@ begin
Result := ErrorResult(errArgError);
if Length(Args) > 0 then
begin
argStr := ArgToString(Args[0]);
case Args[0].ResultType of
rtCell:
{
if Args[0].Parser.IsFormulacell(Args[0].ResSheetName, Args[0].ResRow, Args[0].ResCol) then
Result := ErrorResult(errIllegalRef) // circular reference
else
}
if pos(':', ArgToString(Args[0])) > 0 then
Result := CellRangeResult(Args[0].Parser.Worksheet, ArgToString(Args[0]))
else
Result := CellResult(ArgToString(Args[0]));
{
Result := CellResult(ArgToString(Args[0]));
}
begin
// Can only contain valid cell reference or cell range reference strings.
// Otherwise it is an illegal reference error.
if not (ParseSheetCellString(argStr, sh1, r1, c1) or
ParseCellRangeString(argStr, sh1, sh2, r1, c1, r2, c2, flags)) then
begin
Result := ErrorResult(errIllegalRef);
exit;
end;
if pos(':', argStr) > 0 then
Result := CellRangeResult(Args[0].Parser.Worksheet, argStr)
else
Result := CellResult(argStr);
end;
rtCellRange:
Result := CellRangeResult(Args[0].Parser.Worksheet, ArgToString(Args[0]));
Result := CellRangeResult(Args[0].Parser.Worksheet, argStr);
rtString:
if pos(':', ArgToString(Args[0])) > 0 then
Result := CellRangeResult(Args[0].Parser.Worksheet, ArgToString(Args[0]))
Result := CellRangeResult(Args[0].Parser.Worksheet, argStr)
else
Result := CellResult(Args[0].ResString);
Result := CellResult(argStr);
rtError:
Result := ErrorResult(Args[0].ResError);
end;
end;
end;
{ MATCH( value, array, [match_type]

52
components/fpspreadsheet/unit-tests/common/calcformulatests.pas
View File

@ -740,12 +740,12 @@ begin
FWorksheet.CalcFormulas;
CheckEquals('123456', FWorksheet.ReadAsText(0, 1), 'Formula #4 CONCATENATE(123,456) result mismatch');
(* -- this test will not work in the file because Excel writes a localized "TRUE" to the cell
{ -- this test will not work in the file because Excel writes a localized "TRUE" to the cell
// Concatenate string and boolean
FWorksheet.WriteFormula(0, 1, '=CONCATENATE("abc",TRUE())');
FWorksheet.CalcFormulas;
CheckEquals('abcTRUE', FWorksheet.ReadAsText(0, 1), 'Formula #5 CONCATENATE("abc",TRUE()) result mismatch');
*)
}
// Concatenate 2 string cells
FWorksheet.WriteFormula(0, 1, '=CONCATENATE(A1,A2)');
@ -1539,18 +1539,19 @@ end;
procedure TCalcFormulaTests.Test_INDIRECT;
begin
// *** Test data ***
FWorksheet.WriteNumber(0, 0, 10); // A1
FWorksheet.WriteNumber(1, 0, 20); // A2
FWorksheet.WriteNumber(2, 0, 30); // A3
FWorksheet.WriteText (3, 0, 'A1'); // A4
FWorksheet.WriteErrorValue(4, 0, errDivideByZero); // A5
FWorksheet.WriteText (5, 0, 'A'); // A6
FWorksheet.WriteNumber(6, 0, 1); // A7
FWorksheet.WriteText (7, 0, 'Sheet2'); // A8
FWorksheet.WriteText (8, 0, 'Sheet2!A1:A3'); // A9
FOtherWorksheet.WriteNumber(0, 0, 1000); // Sheet2!A1
FOtherWorksheet.WriteNumber(1, 0, 2000); // Sheet2!A2
FOtherWorksheet.WriteNumber(2, 0, 3000); // Sheet2!A3
FWorksheet.WriteNumber (0, 0, 10); // A1
FWorksheet.WriteNumber (1, 0, 20); // A2
FWorksheet.WriteNumber (2, 0, 30); // A3
FWorksheet.WriteText (3, 0, 'A1'); // A4
FWorksheet.WriteErrorValue(4, 0, errDivideByZero); // A5
FWorksheet.WriteText (5, 0, 'A'); // A6
FWorksheet.WriteNumber (6, 0, 1); // A7
FWorksheet.WriteText (7, 0, 'Sheet2'); // A8
FWorksheet.WriteText (8, 0, 'Sheet2!A1:A3'); // A9
FWorksheet.WriteFormula(9, 0, '=A6&A7'); // A10
FOtherWorksheet.WriteNumber(0, 0, 1000); // Sheet2!A1
FOtherWorksheet.WriteNumber(1, 0, 2000); // Sheet2!A2
FOtherWorksheet.WriteNumber(2, 0, 3000); // Sheet2!A3
// *** Single cell references ***
FWorksheet.WriteFormula(0, 1, '=INDIRECT("A1")');
@ -1574,44 +1575,47 @@ begin
FWorksheet.CalcFormulas;
CheckEquals(10, FWorksheet.ReadAsNumber(0, 1), 'Formula #5 INDIRECT(A6&A7) result mismatch');
FWorksheet.WriteFormula(0, 1, '=INDIRECT(A10)'); // A10 = A6&A7
FWorksheet.CalcFormulas;
CheckEquals(10, FWorksheet.ReadAsNumber(0, 1), 'Formula #6 INDIRECT(A10) result mismatch');
FWorksheet.WriteFormula(0, 1, '=INDIRECT(A8&"!"&A6&A7)'); // --> "Sheet2!A1"
FWorksheet.CalcFormulas;
CheckEquals(1000, FWorksheet.ReadAsNumber(0, 1), 'Formula #6 INDIRECT(A8&"!"&A6&A7) result mismatch');
CheckEquals(1000, FWorksheet.ReadAsNumber(0, 1), 'Formula #7 INDIRECT(A8&"!"&A6&A7) result mismatch');
// Constructing cell address from other cells and constant
FWorksheet.WriteFormula(0, 1, '=INDIRECT(A6&"1")');
FWorksheet.CalcFormulas;
CheckEquals(10, FWorksheet.ReadAsNumber(0, 1), 'Formula #7 INDIRECT(A6&"1") result mismatch');
CheckEquals(10, FWorksheet.ReadAsNumber(0, 1), 'Formula #8 INDIRECT(A6&"1") result mismatch');
// Error in indirectly addressed cell
FWorksheet.WriteFormula(0, 1, '=INDIRECT(A5)');
FWorksheet.CalcFormulas;
CheckEquals(STR_ERR_DIVIDE_BY_ZERO, FWorksheet.ReadAsText(0, 1), 'Formula #8 INDIRECT(A5) result mismatch');
CheckEquals(STR_ERR_DIVIDE_BY_ZERO, FWorksheet.ReadAsText(0, 1), 'Formula #9 INDIRECT(A5) result mismatch');
{ --- not working ! ---
// Circular reference
FWorksheet.WriteFormula(0, 1, '=INDIRECT(A1)');
FWorksheet.CalcFormulas;
CheckEquals(STR_ERR_ILLEGAL_REF, FWorksheet.ReadAsText(0, 1), 'Formula #9 INDIRECT(A1) result mismatch');
}
CheckEquals(STR_ERR_ILLEGAL_REF, FWorksheet.ReadAsText(0, 1), 'Formula #10 INDIRECT(A1) result mismatch');
// *** Cell range references ***
FWorksheet.WriteFormula(0, 1, '=SUM(INDIRECT("A1:A3"))');
FWorksheet.CalcFormulas;
CheckEquals(60, FWorksheet.ReadAsNumber(0, 1), 'Formula #10 SUM(INDIRECT("A1:A3")) result mismatch');
CheckEquals(60, FWorksheet.ReadAsNumber(0, 1), 'Formula #11 SUM(INDIRECT("A1:A3")) result mismatch');
FWorksheet.WriteFormula(0, 1, '=SUM(INDIRECT("Sheet2!A1:A3"))');
FWorksheet.CalcFormulas;
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #11 SUM(INDIRECT("Sheet2!A1:A3")) result mismatch');
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #12 SUM(INDIRECT("Sheet2!A1:A3")) result mismatch');
FWorksheet.WriteFormula(0, 1, '=SUM(INDIRECT(A9))');
FWorksheet.CalcFormulas;
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #12 SUM(INDIRECT(A9)) result mismatch');
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #13 SUM(INDIRECT(A9)) result mismatch');
FWorksheet.WriteFormula(0, 1, '=SUM(INDIRECT(A8&"!"&A4&":A3"))');
FWorksheet.CalcFormulas;
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #13 SUM(INDIRECT(A8&"!"&A4&":A3")) result mismatch');
CheckEquals(6000, FWorksheet.ReadAsNumber(0, 1), 'Formula #14 SUM(INDIRECT(A8&"!"&A4&":A3")) result mismatch');
end;
procedure TCalcFormulaTests.Test_ISBLANK;

18
components/fpspreadsheet/unit-tests/common/testcases_calcrpnformula.inc
View File

@ -4,15 +4,15 @@
// Setting up some test numbers
// Test range M1:O2
MyWorksheet.WriteText(0, 12, 'A'); // M1
MyWorksheet.WriteText(0, 13, 'A'); // N1
MyWorksheet.WriteText(0, 14, 'B'); // O1
MyWorksheet.WriteNumber (1, 12, 1); // M2
MyWorksheet.WriteNumber (1, 13, 2); // N2
MyWorksheet.WriteNumber (1, 14, 3); // O2
MyWorksheet.WriteText (0, 12, 'A'); // M1
MyWorksheet.WriteText (0, 13, 'A'); // N1
MyWorksheet.WriteText (0, 14, 'B'); // O1
MyWorksheet.WriteNumber(1, 12, 1); // M2
MyWorksheet.WriteNumber(1, 13, 2); // N2
MyWorksheet.WriteNumber(1, 14, 3); // O2
// Test cells for "INDIRECT"
MyWorksheet.WriteText(0, 15, 'M1'); // P1
MyWorksheet.WriteText(0, 15, 'M1'); // P1
// Create an error in H2
MyWorksheet.WriteFormula (1, 7, '1/0');
@ -2658,7 +2658,6 @@
SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(SumOfSquares(STATS_NUMBERS));
// { ---- SUMIF currently not supported
// SUMIF
inc(Row);
formula := 'SUMIF(M1:N3,1)';
@ -2708,7 +2707,7 @@
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNCellRange('M1:N3',
RPNString('<>2', // N2=2, 6 other cells --> 5
RPNString('<>2', // M2=1 (N2=2, O2=3) --> 1
RPNFunc('SUMIF', 2, nil)))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
@ -2743,7 +2742,6 @@
MyWorksheet.WriteNumber(Row, 2, 1);
SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(1);
end;
// VAR