FpSpreadsheet: More formula calculation unit tests. Fix some formulas for special arguments.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9603 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
0efab0339c
commit
d80948d93a
@ -863,7 +863,7 @@ function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
|
||||
function ArgToFloatOrNaN(Arg: TsExpressionResult): TsExprFloat;
|
||||
function ArgToString(Arg: TsExpressionResult): String;
|
||||
procedure ArgsToFloatArray(const Args: TsExprParameterArray; AbortOnError: Boolean;
|
||||
out AData: TsExprFloatArray; out AError: TsErrorValue);
|
||||
out AData: TsExprFloatArray; out AError: TsErrorValue; out HasLiteralStrings: Boolean);
|
||||
function BooleanResult(AValue: Boolean): TsExpressionResult;
|
||||
function CellRangeResult(AWorksheet: TsBasicWorksheet; ASheet1Index, ASheet2Index: Integer;
|
||||
ARow1, ACol1, ARow2, ACol2: Cardinal): TsExpressionResult; overload;
|
||||
@ -4789,15 +4789,28 @@ end;
|
||||
function ArgToBoolean(Arg: TsExpressionResult): Boolean;
|
||||
var
|
||||
cell: PCell;
|
||||
x: Double;
|
||||
begin
|
||||
Result := false;
|
||||
if Arg.ResultType = rtString then // All strings result in a #VALUE! error
|
||||
exit;
|
||||
if Arg.ResultType = rtBoolean then
|
||||
Result := Arg.ResBoolean
|
||||
else
|
||||
if (Arg.ResultType = rtCell) then begin
|
||||
cell := ArgToCell(Arg);
|
||||
if (cell <> nil) and (cell^.ContentType = cctBool) then
|
||||
Result := cell^.BoolValue;
|
||||
if (cell <> nil) then
|
||||
case cell^.ContentType of
|
||||
cctBool:
|
||||
Result := cell^.BoolValue;
|
||||
else
|
||||
x := ArgToFloatOrNaN(Arg);
|
||||
Result := not IsNaN(x) and (x <> 0.0);
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
x := ArgToFloatOrNaN(Arg);
|
||||
Result := not IsNaN(x) and (x <> 0.0);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -4949,6 +4962,7 @@ end;
|
||||
function IsError(const AValue: TsExpressionResult; out AError: TsExpressionResult): Boolean;
|
||||
var
|
||||
cell: PCell;
|
||||
i, j: Integer;
|
||||
begin
|
||||
Result := true;
|
||||
if AValue.ResultType = rtError then
|
||||
@ -5014,8 +5028,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Extracts an array of float values (AData) from the expression arguments Args.
|
||||
The variable AError set to an error code when the conversion cannot be
|
||||
performed (errWrongType); when the input argument already contains an error
|
||||
this error code is passed through.
|
||||
AbortOnError determines how arguments with literal string values are handled:
|
||||
When a string cannot be converted to a numerical value and AbortOnError is true
|
||||
the procedure exits with AError = errWrongType; when AbortError is false this
|
||||
argument simply is ignored, but the flag variable HasLiteralstrings is set to true.
|
||||
Non-numeric cell strings are always ignored, AbortOnError is not operative here.
|
||||
}
|
||||
procedure ArgsToFloatArray(const Args: TsExprParameterArray; AbortOnError: Boolean;
|
||||
out AData: TsExprFloatArray; out AError: TsErrorValue);
|
||||
out AData: TsExprFloatArray; out AError: TsErrorValue; out HasLiteralStrings: Boolean);
|
||||
const
|
||||
BLOCKSIZE = 128;
|
||||
var
|
||||
@ -5026,8 +5050,10 @@ var
|
||||
book: TsWorkbook;
|
||||
arg: TsExpressionResult;
|
||||
idx, idx1, idx2: Integer;
|
||||
value: Double;
|
||||
begin
|
||||
AError := errOK;
|
||||
HasLiteralStrings := false;
|
||||
SetLength(AData{%H-}, BLOCKSIZE);
|
||||
n := 0;
|
||||
for i:=Low(Args) to High(Args) do
|
||||
@ -5048,20 +5074,28 @@ begin
|
||||
sheet := book.GetWorksheetByName(arg.ResSheetName);
|
||||
end;
|
||||
cell := sheet.FindCell(arg.ResRow, arg.ResCol);
|
||||
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
|
||||
if (cell <> nil) then
|
||||
begin
|
||||
case cell^.ContentType of
|
||||
cctNumber:
|
||||
AData[n] := cell^.NumberValue;
|
||||
cctDateTime:
|
||||
AData[n] := cell^.DateTimeValue;
|
||||
cctUTF8String:
|
||||
if TryStrToFloat(cell^.UTF8StringValue, value) then
|
||||
AData[n] := value
|
||||
else
|
||||
// non-numeric strings in cells are ignored by Excel
|
||||
Continue;
|
||||
cctError:
|
||||
if AbortOnError then
|
||||
begin
|
||||
AError := cell^.ErrorValue;
|
||||
AData := nil;
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
Continue;
|
||||
else ;
|
||||
end;
|
||||
inc(n);
|
||||
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
|
||||
@ -5077,20 +5111,28 @@ begin
|
||||
for c := arg.ResCellRange.Col1 to arg.ResCellRange.Col2 do
|
||||
begin
|
||||
cell := sheet.FindCell(r, c);
|
||||
if (cell <> nil) and (cell^.ContentType in [cctNumber, cctDateTime]) then
|
||||
if (cell <> nil) then
|
||||
begin
|
||||
case cell^.ContentType of
|
||||
cctNumber:
|
||||
AData[n] := cell^.NumberValue;
|
||||
cctDateTime:
|
||||
AData[n] := cell^.DateTimeValue;
|
||||
cctUTF8String:
|
||||
if TryStrToFloat(cell^.UTF8StringValue, value) then
|
||||
AData[n] := value
|
||||
else
|
||||
// non-numeric strings in cells are ignored by Excel
|
||||
Continue;
|
||||
cctError:
|
||||
if AbortOnError then
|
||||
begin
|
||||
AError := cell^.ErrorValue;
|
||||
AData := nil;
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
Continue;
|
||||
else ;
|
||||
end;
|
||||
inc(n);
|
||||
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
|
||||
@ -5103,6 +5145,22 @@ begin
|
||||
AData[n] := ArgToFloat(arg);
|
||||
inc(n);
|
||||
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
|
||||
end else
|
||||
if (arg.ResultType = rtString) then
|
||||
begin
|
||||
HasLiteralStrings := true;
|
||||
if TryStrToFloat(arg.ResString, value) then
|
||||
begin
|
||||
AData[n] := value;
|
||||
inc(n);
|
||||
if n = Length(AData) then SetLength(AData, Length(AData) + BLOCKSIZE);
|
||||
end else
|
||||
if AbortOnError then
|
||||
begin
|
||||
AError := errWrongType;
|
||||
AData := Nil;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetLength(AData, n);
|
||||
|
||||
@ -1960,6 +1960,11 @@ begin
|
||||
begin
|
||||
if IsError(Args[i], Result) then
|
||||
exit;
|
||||
if (Args[0].ResultType = rtString) then
|
||||
begin
|
||||
Result := ErrorResult(errWrongType);
|
||||
exit;
|
||||
end;
|
||||
if not ArgToBoolean(Args[i]) then begin
|
||||
b := false;
|
||||
break;
|
||||
@ -1982,6 +1987,11 @@ begin
|
||||
exit;
|
||||
if IsError(Args[1], Result) then
|
||||
exit;
|
||||
if (Args[0].ResultType = rtString) then
|
||||
begin
|
||||
Result := ErrorResult(errWrongType);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Length(Args) > 2 then
|
||||
begin
|
||||
@ -2007,11 +2017,16 @@ var
|
||||
begin
|
||||
Result := ErrorResult(errArgError);
|
||||
if (Length(Args) mod 2 <> 0) then // We always need pairs of args
|
||||
exit; // --> If not, exit with argument eror
|
||||
exit; // --> If not, exit with argument eror
|
||||
i:=0;
|
||||
while(i < Length(Args)-1) do begin
|
||||
if IsError(Args[i], Result) then
|
||||
exit;
|
||||
if (Args[0].ResultType = rtString) then // A string never represents a boolean value in Excel
|
||||
begin
|
||||
Result := ErrorResult(errWrongType);
|
||||
exit;
|
||||
end;
|
||||
if ArgToBoolean(Args[i]) then
|
||||
begin
|
||||
Result := Args[i+1];
|
||||
@ -2026,7 +2041,10 @@ procedure fpsNOT(var Result: TsExpressionResult; const Args: TsExprParameterArra
|
||||
begin
|
||||
if IsError(Args[0], Result) then
|
||||
exit;
|
||||
Result.ResBoolean := not ArgToBoolean(Args[0]);
|
||||
if (Args[0].ResultType = rtString) then
|
||||
Result := ErrorResult(errWrongType)
|
||||
else
|
||||
Result.ResBoolean := not ArgToBoolean(Args[0]);
|
||||
end;
|
||||
|
||||
// OR( condition1, [condition2], ... )
|
||||
@ -2041,6 +2059,11 @@ begin
|
||||
begin
|
||||
if IsError(Args[i], Result) then
|
||||
exit;
|
||||
if (Args[0].ResultType = rtString) then
|
||||
begin
|
||||
Result := ErrorResult(errWrongType);
|
||||
exit;
|
||||
end;
|
||||
if ArgToBoolean(Args[i]) then begin
|
||||
b := true;
|
||||
break;
|
||||
@ -2065,32 +2088,50 @@ end;
|
||||
// AVEDEV( value1, [value2, ... value_n] )
|
||||
procedure fpsAVEDEV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
m: TsExprFloat;
|
||||
i: Integer;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
if err <> errOK then begin
|
||||
for i := 0 to Length(Args)-1 do
|
||||
if IsError(Args[i], Result) then
|
||||
exit;
|
||||
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
|
||||
if err = errOK then
|
||||
begin
|
||||
if Length(data) = 0 then
|
||||
begin
|
||||
Result := ErrorResult(errWrongType);
|
||||
exit;
|
||||
end;
|
||||
|
||||
m := Mean(data);
|
||||
for i:=0 to High(data) do // replace data by their average deviation from the mean
|
||||
data[i] := abs(data[i] - m);
|
||||
Result.ResFloat := Mean(data);
|
||||
end else
|
||||
Result := ErrorResult(err);
|
||||
exit;
|
||||
end;
|
||||
m := Mean(data);
|
||||
for i:=0 to High(data) do // replace data by their average deviation from the mean
|
||||
data[i] := abs(data[i] - m);
|
||||
Result.ResFloat := Mean(data);
|
||||
end;
|
||||
|
||||
procedure fpsAVERAGE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// AVERAGE( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
if Length(data) = 0 then
|
||||
Result := ErrorResult(errDivideByZero)
|
||||
else
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
|
||||
if (Length(data) = 0) then
|
||||
if not hasLiteralStrings then
|
||||
begin
|
||||
Result := ErrorResult(errDivideByZero);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if err = errOK then
|
||||
Result.ResFloat := Mean(data)
|
||||
else
|
||||
@ -2102,10 +2143,11 @@ end;
|
||||
COUNT( value1, [value2, ... value_n] ) }
|
||||
procedure fpsCOUNT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, false, data, err);
|
||||
ArgsToFloatArray(Args, false, data, err, hasLiteralStrings);
|
||||
Result := IntegerResult(Length(data));
|
||||
end;
|
||||
|
||||
@ -2126,8 +2168,6 @@ begin
|
||||
for i:=0 to High(Args) do
|
||||
begin
|
||||
arg := Args[i];
|
||||
if IsError(arg, Result) then
|
||||
exit;
|
||||
case arg.ResultType of
|
||||
rtInteger, rtFloat, rtDateTime, rtBoolean:
|
||||
inc(n);
|
||||
@ -2295,7 +2335,7 @@ end;
|
||||
SUMIF( range, condition, [sum_range] )
|
||||
- "range" is the cell range to be analyzed
|
||||
- "condition" can be a cell, a value or a string starting with a symbol like ">" etc.
|
||||
(in the former two cases a value is counted if equal to the criteria value)
|
||||
(in the former two cases a value is added if equal to the criteria value)
|
||||
- "sum_range" - option for the values to be added; if missing the values in
|
||||
"range" are used.}
|
||||
procedure fpsSUMIF(var AResult: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
@ -2346,47 +2386,63 @@ end;
|
||||
procedure fpsMAX(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// MAX( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err = errOK then
|
||||
Result.ResFloat := MaxValue(data)
|
||||
else
|
||||
begin
|
||||
if Length(data) > 0 then
|
||||
Result.ResFloat := MaxValue(data)
|
||||
else
|
||||
Result.ResFloat := 0;
|
||||
end else
|
||||
Result := ErrorResult(err);
|
||||
end;
|
||||
|
||||
procedure fpsMIN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// MIN( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err = errOK then
|
||||
Result.ResFloat := MinValue(data)
|
||||
else
|
||||
begin
|
||||
if Length(data) > 0 then
|
||||
Result.ResFloat := MinValue(data)
|
||||
else
|
||||
Result.ResFloat := 0;
|
||||
end else
|
||||
Result := ErrorResult(err);
|
||||
end;
|
||||
|
||||
procedure fpsPRODUCT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// PRODUCT( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
i: Integer;
|
||||
p: TsExprFloat;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err <> errOK then begin
|
||||
Result := ErrorResult(err);
|
||||
exit;
|
||||
end;
|
||||
|
||||
p := 1.0;
|
||||
for i := 0 to High(data) do
|
||||
p := p * data[i];
|
||||
Result.ResFloat := p;
|
||||
if Length(data) = 0 then
|
||||
Result.ResFloat := 0.0
|
||||
else
|
||||
begin
|
||||
p := 1.0;
|
||||
for i := 0 to High(data) do
|
||||
p := p * data[i];
|
||||
Result.ResFloat := p;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure fpsSTDEV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
@ -2394,10 +2450,11 @@ procedure fpsSTDEV(var Result: TsExpressionResult; const Args: TsExprParameterAr
|
||||
// of numbers.
|
||||
// STDEV( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err <> errOK then begin
|
||||
Result := ErrorResult(err);
|
||||
exit;
|
||||
@ -2416,10 +2473,11 @@ procedure fpsSTDEVP(var Result: TsExpressionResult; const Args: TsExprParameterA
|
||||
// Returns the standard deviation of a population based on an entire population
|
||||
// STDEVP( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err <> errOK then begin
|
||||
Result := ErrorResult(err);
|
||||
exit;
|
||||
@ -2434,41 +2492,44 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure fpsSUM(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// SUM( value1, [value2, ... value_n] )
|
||||
procedure fpsSUM(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err = errOK then
|
||||
Result.ResFloat := Sum(data)
|
||||
else
|
||||
Result := ErrorResult(err);
|
||||
end;
|
||||
|
||||
procedure fpsSUMSQ(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// Returns the sum of the squares of a series of values.
|
||||
// SUMSQ( value1, [value2, ... value_n] )
|
||||
procedure fpsSUMSQ(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err = errOK then
|
||||
Result.ResFloat := SumOfSquares(data)
|
||||
else
|
||||
Result := ErrorResult(err);
|
||||
end;
|
||||
|
||||
procedure fpsVAR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
// Returns the variance of a population based on a sample of numbers.
|
||||
// VAR( value1, [value2, ... value_n] )
|
||||
procedure fpsVAR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args,true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err <> errOK then
|
||||
begin
|
||||
Result := ErrorResult(err);
|
||||
@ -2488,10 +2549,11 @@ procedure fpsVARP(var Result: TsExpressionResult; const Args: TsExprParameterArr
|
||||
// Returns the variance of a population based on an entire population of numbers.
|
||||
// VARP( value1, [value2, ... value_n] )
|
||||
var
|
||||
data: TsExprFloatArray;
|
||||
data: TsExprFloatArray = nil;
|
||||
err: TsErrorValue;
|
||||
hasLiteralStrings: Boolean;
|
||||
begin
|
||||
ArgsToFloatArray(Args, true, data, err);
|
||||
ArgsToFloatArray(Args, true, data, err, hasLiteralStrings);
|
||||
if err <> errOK then
|
||||
begin
|
||||
Result := ErrorResult(err);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -74,7 +74,7 @@
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="36">
|
||||
<Units Count="37">
|
||||
<Unit0>
|
||||
<Filename Value="spreadtestgui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -221,6 +221,10 @@
|
||||
<Filename Value="calcformulatests.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit35>
|
||||
<Unit36>
|
||||
<Filename Value="testcases_calcrpnformula.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit36>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user