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

fpspreadsheet: Complete calculation of logical function for rpn formulas, incl unit tests (passed)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3254 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-30 10:39:49 +00:00
parent 2621b0d028
commit 7b9110ba74
3 changed files with 185 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
components/fpspreadsheet/fpsmath.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, fpspreadsheet; Classes, SysUtils, fpspreadsheet;
type type
TsArgumentType = (atNumber, atString, atBool, atError); TsArgumentType = (atNumber, atString, atBool, atError, atEmpty);
TsArgument = record TsArgument = record
IsMissing: Boolean; IsMissing: Boolean;
@ -41,6 +41,7 @@ function CreateBool(AValue: Boolean): TsArgument;
function CreateNumber(AValue: Double): TsArgument; function CreateNumber(AValue: Double): TsArgument;
function CreateString(AValue: String): TsArgument; function CreateString(AValue: String): TsArgument;
function CreateError(AError: TsErrorValue): TsArgument; function CreateError(AError: TsErrorValue): TsArgument;
function CreateEmpty: TsArgument;
{ {
These are the functions called when calculating an RPN formula. These are the functions called when calculating an RPN formula.
@ -63,8 +64,13 @@ function fpsGreaterEqual(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsLess (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsLess (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsLessEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsLessEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsNotEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsNotEqual (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsAnd (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsOr (Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsAND (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsFALSE (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsIF (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsNOT (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsOR (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsTRUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
implementation implementation
@ -253,68 +259,9 @@ begin
Result.ErrorValue := AError; Result.ErrorValue := AError;
end; end;
function CreateEmpty: TsArgument;
function Pop_1Bool(Args: TsArgumentStack; out a: Boolean): TsErrorValue;
begin begin
Result := GetBoolFromArgument(Args.Pop, a); Result.ArgumentType := atEmpty;
end;
function Pop_1Float(Args: TsArgumentStack; out a: Double): TsErrorValue;
begin
Result := GetNumberFromArgument(Args.Pop, a);
end;
function Pop_1String(Args: TsArgumentStack; out a: String): TsErrorvalue;
begin
Result := GetStringFromArgument(Args.Pop, a);
end;
function Pop_2Bools(Args: TsArgumentStack; out a, b: Boolean): TsErrorValue;
var
erra, errb: TsErrorValue;
begin
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
errb := GetBoolFromArgument(Args.Pop, b);
erra := GetBoolFromArgument(Args.Pop, a);
if erra <> errOK then
Result := erra
else if errb <> errOK then
Result := errb
else
Result := errOK;
end;
function Pop_2Floats(Args: TsArgumentStack; out a, b: Double): TsErrorValue;
var
erra, errb: TsErrorValue;
begin
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
errb := GetNumberFromArgument(Args.Pop, b);
erra := GetNumberFromArgument(Args.Pop, a);
if erra <> errOK then
Result := erra
else if errb <> errOK then
Result := errb
else
Result := errOK;
end;
function Pop_2Strings(Args: TsArgumentStack; out a, b: String): TsErrorValue;
var
erra, errb: TsErrorValue;
begin
// Pop the data in reverse order they were pushed! Otherwise they will be
// applied to the function in the wrong order.
errb := GetStringFromArgument(Args.Pop, b);
erra := GetStringFromArgument(Args.Pop, a);
if erra <> errOK then
Result := erra
else if errb <> errOK then
Result := errb
else
Result := errOK;
end; end;
{@@ {@@
@ -597,7 +544,7 @@ begin
Result := CreateBool(false); Result := CreateBool(false);
end; end;
function fpsAnd(Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsAND(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
data: TBoolArray; data: TBoolArray;
i: Integer; i: Integer;
@ -615,7 +562,39 @@ begin
end; end;
end; end;
function fpsOr(Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsFALSE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
begin
Result := CreateBool(false);
end;
function fpsIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
condition: TsArgument;
case1, case2: TsArgument;
err: TsErrorValue;
begin
if NumArgs = 3 then
case2 := Args.Pop;
case1 := Args.Pop;
condition := Args.Pop;
if condition.ArgumentType <> atBool then
Result := CreateError(errWrongType)
else
case NumArgs of
2: if condition.BoolValue then Result := case1 else Result := Condition;
3: if condition.BoolValue then Result := case1 else Result := case2;
end;
end;
function fpsNOT(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TBoolArray;
begin
if PopBoolValues(Args, NumArgs, data, Result) then
Result := CreateBool(not data[0]);
end;
function fpsOR(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
data: TBoolArray; data: TBoolArray;
i: Integer; i: Integer;
@ -633,4 +612,9 @@ begin
end; end;
end; end;
function fpsTRUE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
begin
Result := CreateBool(true);
end;
end. end.

34
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -511,7 +511,8 @@ type
out ACurrencySymbol: String): Boolean; out ACurrencySymbol: String): Boolean;
{ Writing of values } { Writing of values }
procedure WriteBlank(ARow, ACol: Cardinal); procedure WriteBlank(ARow, ACol: Cardinal); overload;
procedure WriteBlank(ACell: PCell); overload;
procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); overload; procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); overload;
procedure WriteBoolValue(ACell: PCell; AValue: Boolean); overload; procedure WriteBoolValue(ACell: PCell; AValue: Boolean); overload;
@ -1195,11 +1196,11 @@ const
(Symbol:'RATE'; MinParams:3; MaxParams:6; Func:nil), // fekRATE (Symbol:'RATE'; MinParams:3; MaxParams:6; Func:nil), // fekRATE
{ logical } { logical }
(Symbol:'AND'; MinParams:0; MaxParams:30; Func:fpsAND), // fekAND (Symbol:'AND'; MinParams:0; MaxParams:30; Func:fpsAND), // fekAND
(Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:nil), // fekFALSE (Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:fpsFALSE), // fekFALSE
(Symbol:'IF'; MinParams:2; MaxParams:3; Func:nil), // fekIF (Symbol:'IF'; MinParams:2; MaxParams:3; Func:fpsIF), // fekIF
(Symbol:'NOT'; MinParams:1; MaxParams:1; Func:nil), // fekNOT (Symbol:'NOT'; MinParams:1; MaxParams:1; Func:fpsNOT), // fekNOT
(Symbol:'OR'; MinParams:1; MaxParams:30; Func:fpsOR), // fekOR (Symbol:'OR'; MinParams:1; MaxParams:30; Func:fpsOR), // fekOR
(Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:nil), // fekTRUE (Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:fpsTRUE), // fekTRUE
{ string } { string }
(Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR (Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR
(Symbol:'CODE'; MinParams:1; MaxParams:1; Func:nil), // fekCODE (Symbol:'CODE'; MinParams:1; MaxParams:1; Func:nil), // fekCODE
@ -1469,7 +1470,7 @@ begin
val := func(args, fe.ParamsNum); val := func(args, fe.ParamsNum);
// Push valid result on stack, exit in case of error // Push valid result on stack, exit in case of error
case val.ArgumentType of case val.ArgumentType of
atNumber, atString, atBool: atNumber, atString, atBool, atEmpty:
args.Push(val); args.Push(val);
atError: atError:
begin begin
@ -1485,6 +1486,7 @@ begin
atNumber: WriteNumber(ACell, val.NumberValue); atNumber: WriteNumber(ACell, val.NumberValue);
atBool : WriteBoolValue(ACell, val.BoolValue); atBool : WriteBoolValue(ACell, val.BoolValue);
atString: WriteUTF8Text(ACell, val.StringValue); atString: WriteUTF8Text(ACell, val.StringValue);
atEmpty : WriteBlank(ACell);
end; end;
end else end else
// This case is a program error --> raise an exception // This case is a program error --> raise an exception
@ -2414,17 +2416,27 @@ end;
@param ARow The row of the cell @param ARow The row of the cell
@param ACol The column of the cell @param ACol The column of the cell
Note: Empty cells are useful when, for example, a border line extends Note: Empty cells are useful when, for example, a border line extends
along a range of cells including empty cells. along a range of cells including empty cells.
} }
procedure TsWorksheet.WriteBlank(ARow, ACol: Cardinal); procedure TsWorksheet.WriteBlank(ARow, ACol: Cardinal);
var
ACell: PCell;
begin begin
ACell := GetCell(ARow, ACol); WriteBlank(GetCell(ARow, ACol));
end;
{@@
Writes as empty cell
@param ACel Pointer to the cell
Note: Empty cells are useful when, for example, a border line extends
along a range of cells including empty cells.
}
procedure TsWorksheet.WriteBlank(ACell: PCell);
begin
if ACell <> nil then begin
ACell^.ContentType := cctEmpty; ACell^.ContentType := cctEmpty;
ChangedCell(ARow, ACol); ChangedCell(ACell^.Row, ACell^.Col);
end;
end; end;
{@@ {@@

109
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -381,3 +381,112 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true or false or true); sollValues[Row] := CreateBool(true or false or true);
// function =FALSE()
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=FALSE()');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekFALSE, nil)));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(false);
// function =TRUE()
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=TRUE()');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNFunc(fekTRUE, nil)));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(true);
// NOT
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=NOT(false)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(false,
RPNFunc(fekNOT, nil))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(not false);
// IF (2 parameters)/strings/case true
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,"A")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNString('A',
RPNFunc(fekIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateString('A');
// IF (2 parameters) /floats/case true
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNNumber(1.0,
RPNFunc(fekIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
// IF (2 parameters)/strings/case falsee
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,"A")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(false,
RPNString('A',
RPNFunc(fekIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(false);
// IF (2 parameters) /floats/case tfalse
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,1)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(false,
RPNNumber(1.0,
RPNFunc(fekIF, 2, nil)))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateBool(false);
// IF (3 parameters)/strings
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,"A","B")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNString('A',
RPNString('B',
RPNFunc(fekIF, 3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateString('A');
// IF (3 parameters) /floats
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1,2)');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNNumber(1.0,
RPNNumber(2.0,
RPNFunc(fekIF,3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
// IF (3 parameters) /floats / mixed types, case true
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(true,1,"A")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(true,
RPNNumber(1.0,
RPNString('A',
RPNFunc(fekIF,3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateNumber(1);
// IF (3 parameters) /floats / mixed types, case false
inc(Row);
MyWorksheet.WriteUTF8Text(Row, 0, '=IF(false,1,"A")');
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNBool(false,
RPNNumber(1.0,
RPNString('A',
RPNFunc(fekIF, 3, nil))))));
SetLength(sollValues, Row+1);
sollValues[Row] := CreateString('A');