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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3254 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsmath.pas

@@ -8,7 +8,7 @@ uses
   Classes, SysUtils, fpspreadsheet;
 
 type
-  TsArgumentType = (atNumber, atString, atBool, atError);
+  TsArgumentType = (atNumber, atString, atBool, atError, atEmpty);
 
   TsArgument = record
     IsMissing: Boolean;
@@ -41,6 +41,7 @@ function CreateBool(AValue: Boolean): TsArgument;
 function CreateNumber(AValue: Double): TsArgument;
 function CreateString(AValue: String): TsArgument;
 function CreateError(AError: TsErrorValue): TsArgument;
+function CreateEmpty: TsArgument;
 
 {
 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 fpsLessEqual   (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
 
@@ -253,68 +259,9 @@ begin
   Result.ErrorValue := AError;
 end;
 
-
-function Pop_1Bool(Args: TsArgumentStack; out a: Boolean): TsErrorValue;
+function CreateEmpty: TsArgument;
 begin
-  Result := GetBoolFromArgument(Args.Pop, a);
-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;
+  Result.ArgumentType := atEmpty;
 end;
 
 {@@
@@ -597,7 +544,7 @@ begin
     Result := CreateBool(false);
 end;
 
-function fpsAnd(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+function fpsAND(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
 var
   data: TBoolArray;
   i: Integer;
@@ -615,7 +562,39 @@ begin
   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
   data: TBoolArray;
   i: Integer;
@@ -633,4 +612,9 @@ begin
   end;
 end;
 
+function fpsTRUE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+begin
+  Result := CreateBool(true);
+end;
+
 end.

components/fpspreadsheet/fpspreadsheet.pas

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

components/fpspreadsheet/tests/testcases_calcrpnformula.inc

@@ -381,3 +381,112 @@
   SetLength(sollValues, Row+1);
   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');
+