fpspreadsheet: Fix ods formula issues, seems to be ok now.

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

components/fpspreadsheet/fpsexprparser.pas

@@ -3956,47 +3956,56 @@ var
   cell: PCell;
 begin
   Result := 0;
-  if Arg.ResultType = rtInteger then
+  case Arg.ResultType of
-    result := Arg.ResInteger
+    rtInteger  : result := Arg.ResInteger;
-  else
+    rtFloat    : result := trunc(Arg.ResFloat);
-  if Arg.ResultType = rtFloat then
+    rtDateTime : result := trunc(Arg.ResDateTime);
-    result := trunc(Arg.ResFloat)
+    rtBoolean  : if Arg.ResBoolean then Result := 1 else Result := 0;
-  else
+    rtString   : if not TryStrToInt(Arg.ResString, Result) then Result := 0;
-  if Arg.ResultType = rtDateTime then
+    rtCell     : begin
-    result := trunc(Arg.ResDateTime)
-  else
-  if (Arg.ResultType = rtCell) then
-  begin
                    cell := ArgToCell(Arg);
-    if Assigned(cell) and (cell^.ContentType = cctNumber) then
+                   if Assigned(cell) then
-      result := trunc(cell^.NumberValue);
+                     case cell^.ContentType of
+                       cctNumber    : result := trunc(cell^.NumberValue);
+                       cctDateTime  : result := trunc(cell^.DateTimeValue);
+                       cctBool      : if cell^.BoolValue then result := 1;
+                       cctUTF8String: if not TryStrToInt(cell^.UTF8StringValue, result)
+                                        then Result := 0;
+                     end;
+                 end;
   end;
 end;
 
 function ArgToFloat(Arg: TsExpressionResult): TsExprFloat;
-// Utility function for the built-in math functions. Accepts also integers
+// Utility function for the built-in math functions. Accepts also integers and
-// in place of the floating point arguments. To be called in builtins or
+// other data types in place of floating point arguments. To be called in
-// user-defined callbacks having float results.
+// builtins or user-defined callbacks having float results or arguments.
 var
   cell: PCell;
+  s: String;
+  fs: TFormatSettings;
 begin
   Result := 0.0;
-  if Arg.ResultType = rtInteger then
+  case Arg.ResultType of
-    result := Arg.ResInteger
+    rtInteger  : result := Arg.ResInteger;
-  else
+    rtDateTime : result := Arg.ResDateTime;
-  if Arg.ResultType = rtDateTime then
+    rtFloat    : result := Arg.ResFloat;
-    result := Arg.ResDateTime
+    rtBoolean  : if Arg.ResBoolean then Result := 1.0 else Result := 0.0;
-  else
+    rtString   : if not TryStrToFloat(Arg.ResString, Result) then Result := 0.0;
-  if Arg.ResultType = rtFloat then
+    rtCell     : begin
-    result := Arg.ResFloat
-  else
-  if (Arg.ResultType = rtCell) then
-  begin
                    cell := ArgToCell(Arg);
                    if Assigned(cell) then
                      case cell^.ContentType of
                        cctNumber    : Result := cell^.NumberValue;
                        cctDateTime  : Result := cell^.DateTimeValue;
+                       cctBool      : if cell^.BoolValue then result := 1.0;
+                       cctUTF8String: begin
+                                        fs := Arg.Worksheet.Workbook.FormatSettings;
+                                        s := cell^.UTF8StringValue;
+                                        if not TryStrToFloat(s, result, fs) then
+                                          result := 0.0;
+                                      end;
+                     end;
                  end;
   end;
 end;
@@ -4004,38 +4013,60 @@ end;
 function ArgToDateTime(Arg: TsExpressionResult): TDateTime;
 var
   cell: PCell;
+  fs: TFormatSettings;
 begin
   Result := 0.0;
-  if Arg.ResultType = rtDateTime then
+  case Arg.ResultType of
-    result := Arg.ResDateTime
+    rtDateTime  : result := Arg.ResDateTime;
-  else
+    rtInteger   : Result := Arg.ResInteger;
-  if Arg.ResultType = rtInteger then
+    rtFloat     : Result := Arg.ResFloat;
-    Result := Arg.ResInteger
+    rtBoolean   : if Arg.ResBoolean then Result := 1.0;
-  else
+    rtString    : begin
-  if Arg.ResultType = rtFloat then
+                    fs := Arg.Worksheet.Workbook.FormatSettings;
-    Result := Arg.ResFloat
+                    if not TryStrToDateTime(Arg.ResString, Result) then
-  else
+                      Result := 1.0;
-  if (Arg.ResultType = rtCell) then
+                  end;
-  begin
+    rtCell      : begin
                     cell := ArgToCell(Arg);
-    if Assigned(cell) and (cell^.ContentType = cctDateTime) then
+                    if Assigned(cell) then
+                      if (cell^.ContentType = cctDateTime) then
                         Result := cell^.DateTimeValue;
                   end;
   end;
+end;
 
 function ArgToString(Arg: TsExpressionResult): String;
+// The Office applications are very fuzzy about data types...
 var
   cell: PCell;
+  fs: TFormatSettings;
+  dt: TDateTime;
 begin
   Result := '';
   case Arg.ResultType of
     rtString  : result := Arg.ResString;
     rtInteger : Result := IntToStr(Arg.ResInteger);
     rtFloat   : Result := FloatToStr(Arg.ResFloat);
+    rtBoolean : if Arg.ResBoolean then Result := '1' else Result := '0';
     rtCell    : begin
                   cell := ArgToCell(Arg);
-                  if Assigned(cell) and (cell^.ContentType = cctUTF8String) then
+                  if Assigned(cell) then
-                    Result := cell^.UTF8Stringvalue;
+                    case cell^.ContentType of
+                      cctUTF8String : Result := cell^.UTF8Stringvalue;
+                      cctNumber     : Result := Format('%g', [cell^.NumberValue]);
+                      cctBool       : if cell^.BoolValue then Result := '1' else Result := '0';
+                      cctDateTime   : begin
+                                        fs := Arg.Worksheet.Workbook.FormatSettings;
+                                        dt := cell^.DateTimeValue;
+                                        if frac(dt) = 0.0 then
+                                          Result := FormatDateTime(fs.LongTimeFormat, dt, fs)
+                                        else
+                                        if trunc(dt) = 0 then
+                                          Result := FormatDateTime(fs.ShortDateFormat, dt, fs)
+                                        else
+                                          Result := FormatDateTime('cc', dt, fs);
+                                      end;
+                    end;
                 end;
   end;
 end;
@@ -4070,7 +4101,7 @@ begin
           end;
         end
     else
-    if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell]) then
+    if (arg.ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtBoolean]) then
     begin
       AData[n] := ArgToFloat(arg);
       inc(n);

components/fpspreadsheet/fpsopendocument.pas

@@ -1230,9 +1230,12 @@ begin
   end;
 
   // Read formula results
-  // ... number value
   valueType := GetAttrValue(ACellNode, 'office:value-type');
   valueStr := GetAttrValue(ACellNode, 'office:value');
+  // ODS wants a 0 in the NumberValue field in case of an error. If there is
+  // no error, this value will be corrected below.
+  cell^.NumberValue := 0.0;
+  // (a) number value
   if (valueType = 'float') then begin
     if UpperCase(valueStr) = '1.#INF' then
       FWorksheet.WriteNumber(cell, 1.0/0.0)
@@ -1253,12 +1256,12 @@ begin
         end;
     end;
   end else
-  // Date/time value
+  // (b) Date/time value
   if (valueType = 'date') or (valueType = 'time') then begin
     floatValue := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr);
     FWorkSheet.WriteDateTime(cell, floatValue);
   end else
-  // text
+  // (c) text
   if (valueType = 'string') then begin
     node := ACellNode.FindNode('text:p');
     if (node <> nil) and (node.FirstChild <> nil) then begin
@@ -1266,7 +1269,7 @@ begin
       FWorksheet.WriteUTF8Text(cell, valueStr);
     end;
   end else
-  // Text
+  // (e) Text
     FWorksheet.WriteUTF8Text(cell, valueStr);
 
   if FIsVirtualMode then
@@ -3604,6 +3607,7 @@ var
   formula: String;
   valuetype: String;
   value: string;
+  valueStr: String;
 begin
   Unused(AStream, ARow, ACol);
 
@@ -3623,6 +3627,7 @@ begin
     parser.Free;
   end;
 
+  valueStr := '';
   case ACell^.ContentType of
     cctNumber:
       begin
@@ -3647,6 +3652,7 @@ begin
       begin
         valuetype := 'string';
         value := 'office:string-value="' + ACell^.UTF8StringValue +'"';
+        valueStr := '<text:p>' + ACell^.UTF8StringValue + '</text:p>';
       end;
     cctBool:
       begin
@@ -3655,8 +3661,10 @@ begin
       end;
     cctError:
       begin
-        valuetype := 'error';
+        // Strange: but in case of an error, Open/LibreOffice always writes a
-        value := 'office:value="' + GetErrorValueStr(ACell^.ErrorValue) + '"';
+        // float value 0 to the cell
+        valuetype := 'float';
+        value := 'office:value="0"';
       end;
   end;
 
@@ -3668,10 +3676,9 @@ begin
   if ACell^.CalcState=csCalculated then
     AppendToStream(AStream, Format(
       '<table:table-cell table:formula="=%s" office:value-type="%s" %s %s>' +
-  //      '<text:p>%s</text:p>'+
+      valueStr +
       '</table:table-cell>', [
       formula, valuetype, value, lStyle
-      //value
     ]))
   else
     AppendToStream(AStream, Format(

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -48,10 +48,12 @@
       <Unit1>
         <Filename Value="datetests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="datetests"/>
       </Unit1>
       <Unit2>
         <Filename Value="stringtests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="stringtests"/>
       </Unit2>
       <Unit3>
         <Filename Value="numberstests.pas"/>
@@ -61,7 +63,6 @@
       <Unit4>
         <Filename Value="manualtests.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="manualtests"/>
       </Unit4>
       <Unit5>
         <Filename Value="testsutility.pas"/>
@@ -71,6 +72,7 @@
       <Unit6>
         <Filename Value="internaltests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="internaltests"/>
       </Unit6>
       <Unit7>
         <Filename Value="formattests.pas"/>
@@ -80,6 +82,7 @@
       <Unit8>
         <Filename Value="colortests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="colortests"/>
       </Unit8>
       <Unit9>
         <Filename Value="fonttests.pas"/>
@@ -96,7 +99,6 @@
       <Unit12>
         <Filename Value="rpnformulaunit.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="rpnFormulaUnit"/>
       </Unit12>
       <Unit13>
         <Filename Value="formulatests.pas"/>
@@ -110,10 +112,12 @@
       <Unit15>
         <Filename Value="errortests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="errortests"/>
       </Unit15>
       <Unit16>
         <Filename Value="virtualmodetests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="virtualmodetests"/>
       </Unit16>
     </Units>
   </ProjectOptions>

components/fpspreadsheet/tests/testcases_calcrpnformula.inc

@@ -220,6 +220,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteErrorValue(Row, 2, errDivideByZero);
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errDivideByZero);
 
   // Division of cell values
@@ -956,9 +959,12 @@
       RPNFunc('ACOS', nil))))
   else
     MyWorksheet.WriteFormula(Row, 1, formula);
+  MyWorksheet.WriteErrorValue(Row, 2, errOverflow);;
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverFlow);
-  MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
 
    // ARCCOSH - valid result
   inc(Row);
@@ -985,9 +991,12 @@
       RPNFunc('ACOSH', nil))))
   else
     MyWorksheet.WriteFormula(Row, 1, formula);
-  SetLength(sollValues, Row+1);
-  sollValues[Row] := ErrorResult(errOverFlow);
   MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
+  SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
+    sollValues[Row] := ErrorResult(errOverFlow);
 
   // ASIN
   inc(Row);
@@ -1014,9 +1023,12 @@
       RPNFunc('ASIN', nil))))
   else
     Myworksheet.WriteFormula(Row, 1, formula);
-  SetLength(sollValues, Row+1);
-  sollValues[Row] := ErrorResult(errOverFlow);
   MyWorksheet.WriteErrorValue(Row, 2, errOverflow);
+  SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
+    sollValues[Row] := ErrorResult(errOverFlow);
 
    // ARCSINH
   inc(Row);
@@ -1073,9 +1085,12 @@
       RPNFunc('ATANH', nil))))
   else
     myWorksheet.WriteFormula(Row, 1, formula);
-  SetLength(sollValues, Row+1);
-  sollValues[Row] := ErrorResult(errOverFlow);
   MyWorksheet.WriteErrorValue(Row, 2, errOverFlow);
+  SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
+    sollValues[Row] := ErrorResult(errOverFlow);
 
   // CEILING
   if AFormat <> sfExcel2 then begin
@@ -1262,6 +1277,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   myWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LN - error due to argument < 0
@@ -1276,6 +1294,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LOG10 - valid result
@@ -1305,6 +1326,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   myWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LOG10 - error due to argument < 0
@@ -1319,6 +1343,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverFlow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LOG - valid result (2 arguments)
@@ -1352,6 +1379,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 }
 
@@ -1383,6 +1413,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LOG - negative value
@@ -1398,6 +1431,9 @@
     MyWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // LOG of cell
@@ -1623,6 +1659,9 @@
     myWorksheet.WriteFormula(Row, 1, formula);
   MyWorksheet.WriteUTF8Text(Row, 2, GetErrorValueStr(errOverflow));
   SetLength(sollValues, Row+1);
+  if AFormat = sfOpenDocument then
+    sollValues[Row] := FloatResult(0)
+  else
     sollValues[Row] := ErrorResult(errOverflow);
 
   // SQRT of cell value