fpspreadsheet: Fix compare operations when calculating rpn formula

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3250 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2014-06-29 09:55:47 +00:00
parent cd9e686804
commit b5f465ac84
5 changed files with 343 additions and 38 deletions
--- a/components/fpspreadsheet/fpsmath.pas
+++ b/components/fpspreadsheet/fpsmath.pas
@ -52,12 +52,19 @@ function fpsAdd    (Args: TsArgumentStack): TsArgument;
 function fpsSub      (Args: TsArgumentStack): TsArgument;
 function fpsMul      (Args: TsArgumentStack): TsArgument;
 function fpsDiv      (Args: TsArgumentStack): TsArgument;
-function fpsPercent(Args: TsArgumentStack): TsArgument;
+function fpsPercent  (Args: TsArgumentStack): TsArgument;
 function fpsPower    (Args: TsArgumentStack): TsArgument;
 function fpsUMinus   (Args: TsArgumentStack): TsArgument;
 function fpsUPlus    (Args: TsArgumentStack): TsArgument;
 function fpsConcat   (Args: TsArgumentStack): TsArgument;
 function fpsEqual    (Args: TsArgumentStack): TsArgument;
+function fpsGreater  (Args: TsArgumentStack): TsArgument;
+function fpsGreaterEqual(Args: TsArgumentStack): TsArgument;
+function fpsLess     (Args: TsArgumentStack): TsArgument;
+function fpsLessEqual(Args: TsArgumentStack): TsArgument;
+function fpsNotEqual (Args: TsArgumentStack): TsArgument;
+
+function fpsAnd      (Args: TsArgumentStack): TsArgument;

 implementation

@ -425,13 +432,115 @@ begin
 end;

 function fpsEqual(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue = arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue = arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue = arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+function fpsGreater(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue > arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue > arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue > arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+function fpsGreaterEqual(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue >= arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue >= arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue >= arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+function fpsLess(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue < arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue < arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue < arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+function fpsLessEqual(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue <= arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue <= arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue <= arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+
+function fpsNotEqual(Args: TsArgumentStack): TsArgument;
+var
+  arg1, arg2: TsArgument;
+begin
+  arg2 := Args.Pop;
+  arg1 := Args.Pop;
+  if arg1.ArgumentType = arg2.ArgumentType then
+    case arg1.ArgumentType of
+      atNumber  : Result := CreateBool(arg1.NumberValue <> arg2.NumberValue);
+      atString  : Result := CreateBool(arg1.StringValue <> arg2.StringValue);
+      atBool    : Result := CreateBool(arg1.Boolvalue <> arg2.BoolValue);
+    end
+  else
+    Result := CreateBool(false);
+end;
+
+
+
+
+// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+//   Variable parameter count !!!!!!!!!!!!
+function fpsAnd(Args: TsArgumentStack): TsArgument;
 var
  a, b: Boolean;
  err: TsErrorValue;
 begin
  err := Pop_2Bools(Args, a, b);
  if err = errOK then
-    Result := CreateBool(a = b)
+    Result := CreateBool(a and b)
  else
    Result := CreateError(err);
 end;
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@ -512,7 +512,9 @@ type

    { Writing of values }
    procedure WriteBlank(ARow, ACol: Cardinal);
-    procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
+
+    procedure WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean); overload;
+    procedure WriteBoolValue(ACell: PCell; AValue: Boolean); overload;

    procedure WriteCellValueAsString(ARow, ACol: Cardinal; AValue: String); overload;
    procedure WriteCellValueAsString(ACell: PCell; AValue: String); overload;
@ -1112,12 +1114,12 @@ const
    (Symbol:'-';         MinParams:1; MaxParams:1;  Func:fpsUMinus),            // fekUMinus
    (Symbol:'+';         MinParams:1; MaxParams:1;  Func:fpsUPlus),             // fekUPlus
    (Symbol:'&';         MinParams:2; MaxParams:2;  Func:fpsConcat),            // fekConcat (string concatenation)
-    (Symbol:'=';         MinParams:2; MaxParams:2;  Func:nil),   // fekEqual
-    (Symbol:'>';         MinParams:2; MaxParams:2;  Func:nil),   // fekGreater
-    (Symbol:'>=';        MinParams:2; MaxParams:2;  Func:nil),   // fekGreaterEqual
-    (Symbol:'<';         MinParams:2; MaxParams:2;  Func:nil),   // fekLess
-    (Symbol:'<=';        MinParams:2; MaxParams:2;  Func:nil),   // fekLessEqual
-    (Symbol:'<>';        MinParams:2; MaxParams:2;  Func:nil),   // fekNotEqual
+    (Symbol:'=';         MinParams:2; MaxParams:2;  Func:fpsEqual),             // fekEqual
+    (Symbol:'>';         MinParams:2; MaxParams:2;  Func:fpsGreater),           // fekGreater
+    (Symbol:'>=';        MinParams:2; MaxParams:2;  Func:fpsGreaterEqual),      // fekGreaterEqual
+    (Symbol:'<';         MinParams:2; MaxParams:2;  Func:fpsLess),              // fekLess
+    (Symbol:'<=';        MinParams:2; MaxParams:2;  Func:fpsLessEqual),         // fekLessEqual
+    (Symbol:'<>';        MinParams:2; MaxParams:2;  Func:fpsNotEqual),          // fekNotEqual
    (Symbol:'';          MinParams:1; MaxParams:1;  Func:nil),   // fekParen
  { math }
    (Symbol:'ABS';       MinParams:1; MaxParams:1; Func:nil),   // fekABS
@ -1192,7 +1194,7 @@ const
    (Symbol:'PV';        MinParams:3; MaxParams:5; Func:nil),   // fekPV
    (Symbol:'RATE';      MinParams:3; MaxParams:6; Func:nil),   // fekRATE
  { logical }
-    (Symbol:'AND';       MinParams:0; MaxParams:30; Func:nil),  // fekAND
+    (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
@ -1481,16 +1483,9 @@ begin
      val := args.Pop;
      case val.ArgumentType of
        atNumber: WriteNumber(ACell, val.NumberValue);
-        atBool  : WriteNumber(ACell, 1.0*ord(val.BoolValue));
+        atBool  : WriteBoolValue(ACell, val.BoolValue);
        atString: WriteUTF8Text(ACell, val.StringValue);
      end;
-      {
-      case val.ArgumentType of
-        atNumber: ACell^.NumberValue := val.NumberValue; //WriteNumber(ACell, val.NumberValue);
-        atBool  : ACell^.NumberValue := 1.0 * ord(val.BoolValue); //WriteNumber(ACell, 1.0*ord(val.BoolValue));
-        atString: ACell^.UTF8StringValue := val.StringValue; //(ACell, val.StringValue);
-      end;
-      }
    end else
      // This case is a program error --> raise an exception
      raise Exception.CreateFmt('Incorrect argument count of the formula in cell %s', [
@ -2440,13 +2435,23 @@ end;
  @param  AValue     The boolean value
 }
 procedure TsWorksheet.WriteBoolValue(ARow, ACol: Cardinal; AValue: Boolean);
-var
-  ACell: PCell;
 begin
-  ACell := GetCell(ARow, ACol);
+  WriteBoolValue(GetCell(ARow, ACol), AValue);
+end;
+
+{@@
+  Writes as boolean cell
+
+  @param  ACell      Pointer to the cell
+  @param  AValue     The boolean value
+}
+procedure TsWorksheet.WriteBoolValue(ACell: PCell; AValue: Boolean);
+begin
+  if ACell <> nil then begin
    ACell^.ContentType := cctBool;
    ACell^.BoolValue := AValue;
-  ChangedCell(ARow, ACol);
+    ChangedCell(ACell^.Row, ACell^.Col);
+  end;
 end;

 {@@
--- a/components/fpspreadsheet/tests/formulatests.pas
+++ b/components/fpspreadsheet/tests/formulatests.pas
@ -178,7 +178,7 @@ begin
    if (cell = nil) then
      fail('Error in test code: Failed to get cell ' + CellNotation(MyWorksheet, Row, 1));
    case cell^.ContentType of
-      cctBool       : actual := CreateBool(cell^.NumberValue <> 0);
+      cctBool       : actual := CreateBool(cell^.BoolValue);
      cctNumber     : actual := CreateNumber(cell^.NumberValue);
      cctError      : actual := CreateError(cell^.ErrorValue);
      cctUTF8String : actual := CreateString(cell^.UTF8StringValue);
--- a/components/fpspreadsheet/tests/testcases_calcrpnformula.inc
+++ b/components/fpspreadsheet/tests/testcases_calcrpnformula.inc
@ -122,7 +122,18 @@
    RPNFunc(fekConcat, nil)))));
  SetLength(sollValues, Row+1);
  sollValues[Row] := CreateString('Hallo' + ' world');
-(*
+
+  // Equal (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true=false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true = false);
+
  // Equal (strings)
  inc(Row);
  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo"="world")');
@ -130,7 +141,7 @@
    RPNString('Hallo',
    RPNString('world',
    RPNParenthesis(
-    RPNFunc(fekConcat, nil))))));
+    RPNFunc(fekEqual, nil))))));
  SetLength(sollValues, Row+1);
  sollValues[Row] := CreateBool('Hallo' = 'world');

@ -144,4 +155,184 @@
    RPNFunc(fekEqual, nil))))));
  SetLength(sollValues, Row+1);
  sollValues[Row] := CreateBool(1=1);
+
+  // Greater (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true>false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekGreater, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true > false);
+
+  // Greater (strings)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo">"world")');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNString('Hallo',
+    RPNString('world',
+    RPNParenthesis(
+    RPNFunc(fekGreater, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool('Hallo' > 'world');
+
+  // Greater (numbers)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(1>1)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNNumber(1.0,
+    RPNNumber(1.0,
+    RPNParenthesis(
+    RPNFunc(fekGreater, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(1>1);
+
+  // Greater equal (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true>=false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekGreaterEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true >= false);
+
+  // Greater equal (strings)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo">="world")');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNString('Hallo',
+    RPNString('world',
+    RPNParenthesis(
+    RPNFunc(fekGreaterEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool('Hallo' >= 'world');
+
+  // Greater equal (numbers)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(1>=1)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNNumber(1.0,
+    RPNNumber(1.0,
+    RPNParenthesis(
+    RPNFunc(fekGreaterEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(1>=1);
+
+  // Less (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true<false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekLess, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true < false);
+
+  // Less (strings)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo"<"world")');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNString('Hallo',
+    RPNString('world',
+    RPNParenthesis(
+    RPNFunc(fekLess, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool('Hallo' < 'world');
+
+  // Less (numbers)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(1<1)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNNumber(1.0,
+    RPNNumber(1.0,
+    RPNParenthesis(
+    RPNFunc(fekLess, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(1<1);
+
+  // Less equal (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true<=false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekLessEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true <= false);
+
+  // Less equal (strings)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo"<="world")');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNString('Hallo',
+    RPNString('world',
+    RPNParenthesis(
+    RPNFunc(fekLessEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool('Hallo' <= 'world');
+
+  // Less equal (numbers)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(1<=1)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNNumber(1.0,
+    RPNNumber(1.0,
+    RPNParenthesis(
+    RPNFunc(fekLessEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(1<=1);
+
+  // Not equal (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(true<>false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNParenthesis(
+    RPNFunc(fekNotEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true <> false);
+
+  // Not equal (strings)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=("Hallo"<>"world")');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNString('Hallo',
+    RPNString('world',
+    RPNParenthesis(
+    RPNFunc(fekNotEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool('Hallo' <> 'world');
+
+  // Not equal (numbers)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=(1<>1)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNNumber(1.0,
+    RPNNumber(1.0,
+    RPNParenthesis(
+    RPNFunc(fekNotEqual, nil))))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(1<>1);
+
+
+
+                (*  variable param count !!!!!!!!!!!!!!!!
+  // AND (bool)
+  inc(Row);
+  MyWorksheet.WriteUTF8Text(Row, 0, '=AND(true,false)');
+  MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
+    RPNBool(true,
+    RPNBool(false,
+    RPNFunc(fekAND, nil)))));
+  SetLength(sollValues, Row+1);
+  sollValues[Row] := CreateBool(true and false);
                  *)
+
+
--- a/components/fpspreadsheet/xlsbiff8.pas
+++ b/components/fpspreadsheet/xlsbiff8.pas
@ -825,7 +825,7 @@ begin
    cctBool:
      begin
        FormulaResultWords[0] := 1;
-        FormulaResultWords[1] := word(ACell^.NumberValue <> 0);
+        FormulaResultWords[1] := ord(ACell^.BoolValue);
        FormulaResultWords[3] := $FFFF;
      end;
    cctError: