fpspreadsheet: Fix formula issues with ods (written error values still different between fps and ods).

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

components/fpspreadsheet/fpsexprparser.pas

@@ -715,6 +715,7 @@ type
     procedure CheckResultType(const Res: TsExpressionResult;
       AType: TsResultType); inline;
     function CurrentToken: String;
+    function CurrentOrEOFToken: String;
     function GetToken: TsTokenType;
     function Level1: TsExprNode;
     function Level2: TsExprNode;
@@ -1067,8 +1068,8 @@ begin
     FToken := FToken + C;
     C := NextPos;
   end;
-  FToken := Copy(FToken, 2, Length(FToken) - 2);  // Delete "[" and "]"
+  C := NextPos;
-  p := system.pos('.', FToken);                          // Delete up tp "."  (--> to be considered later!)
+  p := system.pos('.', FToken);  // Delete up tp "."  (--> to be considered later!)
   if p <> 0 then Delete(FToken, 1, p);
   if system.pos(':', FToken) > 0 then
   begin
@@ -1312,6 +1313,14 @@ begin
   Result := FScanner.Token;
 end;
 
+function TsExpressionParser.CurrentOrEOFToken: String;
+begin
+  if (FScanner.TokenType = ttEOF) or (FScanner.Token = '') then
+    Result := 'end of formula'
+  else
+    Result := FScanner.Token;
+end;
+
 function TsExpressionParser.Evaluate: TsExpressionResult;
 begin
   EvaluateExpression(Result);
@@ -1559,6 +1568,7 @@ function TsExpressionParser.Level6: TsExprNode;
 var
   tt: TsTokenType;
   Right: TsExprNode;
+  currToken: String;
 begin
 {$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
   if (TokenType = ttLeft) then
@@ -1566,8 +1576,11 @@ begin
     GetToken;
     Result := TsParenthesisExprNode.Create(self, Level1);
     try
-      if (TokenType <> ttRight) then
+      if (TokenType <> ttRight) then begin
-        ParserError(Format(SErrBracketExpected, [SCanner.Pos, CurrentToken]));
+        currToken := CurrentToken;
+        if TokenType = ttEOF then currToken := 'end of formula';
+        ParserError(Format(SErrBracketExpected, [SCanner.Pos, currToken]));
+      end;
       GetToken;
     except
       Result.Free;
@@ -1675,10 +1688,10 @@ begin
       begin
         GetToken;
         if (TokenType <> ttLeft) then
-          ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
+          ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentOrEOFToken]));
         GetToken;
         if (TokenType <> ttRight) then
-          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
+          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentOrEOFToken]));
         SetLength(Args, 0);
       end;
     end
@@ -1691,7 +1704,7 @@ begin
     begin
       GetToken;
       if (TokenType <> ttLeft) then
-        ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentToken]));
+        ParserError(Format(SErrLeftBracketExpected, [Scanner.Pos, CurrentOrEofToken]));
       SetLength(Args, abs(lCount));
       AI := 0;
       try
@@ -1710,11 +1723,11 @@ begin
           begin
             if (TokenType <> ttListSep) then
               if (AI < abs(lCount)) then
-                ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentToken]))
+                ParserError(Format(SErrCommaExpected, [Scanner.Pos, CurrentOrEofToken]))
           end;
         until (AI = lCount) or (((lCount < 0) or optional) and (TokenType = ttRight));
         if TokenType <> ttRight then
-          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentToken]));
+          ParserError(Format(SErrBracketExpected, [Scanner.Pos, CurrentOrEofToken]));
         if AI < abs(lCount) then
           SetLength(Args, AI);
       except

components/fpspreadsheet/fpsopendocument.pas

@@ -1082,6 +1082,29 @@ begin
   FColumnStyleList.Add(colStyle);
 end;
 
+procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol: Word;
+  ACellNode : TDOMNode);
+var
+  dt: TDateTime;
+  styleName: String;
+  cell: PCell;
+begin
+  if FIsVirtualMode then begin
+    InitCell(ARow, ACol, FVirtualCell);
+    cell := @FVirtualCell;
+  end else
+    cell := FWorksheet.GetCell(ARow, ACol);
+
+  styleName := GetAttrValue(ACellNode, 'table:style-name');
+  ApplyStyleToCell(cell, stylename);
+
+  dt := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr);
+  FWorkSheet.WriteDateTime(cell, dt, cell^.NumberFormat, cell^.NumberFormatStr);
+
+  if FIsVirtualMode then
+    Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
+end;
+
 procedure TsSpreadOpenDocReader.ReadDateMode(SpreadSheetNode: TDOMNode);
 var
   CalcSettingsNode, NullDateNode: TDOMNode;
@@ -1160,6 +1183,96 @@ begin
   end;
 end;
 
+procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode);
+var
+  cell: PCell;
+  formula: String;
+  stylename: String;
+  floatValue: Double;
+  valueType: String;
+  valueStr: String;
+  node: TDOMNode;
+  parser: TsSpreadsheetParser;
+  p: Integer;
+begin
+  // Create cell and apply format
+  if FIsVirtualMode then
+  begin
+    InitCell(ARow, ACol, FVirtualCell);
+    cell := @FVirtualCell;
+  end else
+    cell := FWorksheet.GetCell(ARow, ACol);
+
+  styleName := GetAttrValue(ACellNode, 'table:style-name');
+  ApplyStyleToCell(cell, stylename);
+
+  if (boReadFormulas in FWorkbook.Options) then begin
+    // Read formula, trim it, ...
+    formula := GetAttrValue(ACellNode, 'table:formula');
+    if formula <> '' then
+    begin
+      // formulas written by Spread begin with 'of:=', our's with '=' --> remove that
+      p := pos('=', formula);
+      Delete(formula, 1, p);
+    end;
+    // ... convert to Excel dialect used by fps by defailt
+    parser := TsSpreadsheetParser.Create(FWorksheet);
+    try
+      parser.Dialect := fdOpenDocument;
+      parser.LocalizedExpression[FPointSeparatorSettings] := formula;
+      parser.Dialect := fdExcel;
+      formula := parser.Expression;
+    finally
+      parser.Free;
+    end;
+    // ... and store in cell's FormulaValue field.
+    cell^.FormulaValue := formula;
+  end;
+
+  // Read formula results
+  // ... number value
+  valueType := GetAttrValue(ACellNode, 'office:value-type');
+  valueStr := GetAttrValue(ACellNode, 'office:value');
+  if (valueType = 'float') then begin
+    if UpperCase(valueStr) = '1.#INF' then
+      FWorksheet.WriteNumber(cell, 1.0/0.0)
+    else begin
+      floatValue := StrToFloat(valueStr, FPointSeparatorSettings);
+      FWorksheet.WriteNumber(cell, floatValue);
+    end;
+    if IsDateTimeFormat(cell^.NumberFormat) then begin
+      cell^.ContentType := cctDateTime;
+      // No datemode correction for intervals and for time-only values
+      if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
+        cell^.DateTimeValue := cell^.NumberValue
+      else
+        case FDateMode of
+          dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
+          dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
+          dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
+        end;
+    end;
+  end else
+  // 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
+  if (valueType = 'string') then begin
+    node := ACellNode.FindNode('text:p');
+    if (node <> nil) and (node.FirstChild <> nil) then begin
+      valueStr := node.FirstChild.Nodevalue;
+      FWorksheet.WriteUTF8Text(cell, valueStr);
+    end;
+  end else
+  // Text
+    FWorksheet.WriteUTF8Text(cell, valueStr);
+
+  if FIsVirtualMode then
+    Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
+end;
+
 procedure TsSpreadOpenDocReader.ReadFromFile(AFileName: string; AData: TsWorkbook);
 var
   Doc : TXMLDocument;
@@ -1249,96 +1362,6 @@ begin
   end;
 end;
 
-procedure TsSpreadOpenDocReader.ReadFormula(ARow: Word; ACol : Word; ACellNode : TDOMNode);
-var
-  cell: PCell;
-  formula: String;
-  stylename: String;
-  floatValue: Double;
-  valueType: String;
-  valueStr: String;
-  node: TDOMNode;
-  parser: TsSpreadsheetParser;
-  p: Integer;
-begin
-  // Create cell and apply format
-  if FIsVirtualMode then
-  begin
-    InitCell(ARow, ACol, FVirtualCell);
-    cell := @FVirtualCell;
-  end else
-    cell := FWorksheet.GetCell(ARow, ACol);
-
-  styleName := GetAttrValue(ACellNode, 'table:style-name');
-  ApplyStyleToCell(cell, stylename);
-
-  if (boReadFormulas in FWorkbook.Options) then begin
-    // Read formula, trim it, ...
-    formula := GetAttrValue(ACellNode, 'table:formula');
-    if formula <> '' then
-    begin
-      // formulas written by Spread begin with 'of:=', our's with '=' --> remove that
-      p := pos('=', formula);
-      Delete(formula, 1, p);
-    end;
-    // ... convert to Excel dialect used by fps by defailt
-    parser := TsSpreadsheetParser.Create(FWorksheet);
-    try
-      parser.Dialect := fdOpenDocument;
-      parser.Expression := formula;
-      parser.Dialect := fdExcel;
-      formula := parser.Expression;
-    finally
-      parser.Free;
-    end;
-    // ... and store in cell's FormulaValue field.
-    cell^.FormulaValue := formula;
-  end;
-
-  // Read formula results
-  // ... number value
-  valueType := GetAttrValue(ACellNode, 'office:value-type');
-  valueStr := GetAttrValue(ACellNode, 'office:value');
-  if (valueType = 'float') then begin
-    if UpperCase(valueStr) = '1.#INF' then
-      FWorksheet.WriteNumber(cell, 1.0/0.0)
-    else begin
-      floatValue := StrToFloat(valueStr, FPointSeparatorSettings);
-      FWorksheet.WriteNumber(cell, floatValue);
-    end;
-    if IsDateTimeFormat(cell^.NumberFormat) then begin
-      cell^.ContentType := cctDateTime;
-      // No datemode correction for intervals and for time-only values
-      if (cell^.NumberFormat = nfTimeInterval) or (cell^.NumberValue < 1) then
-        cell^.DateTimeValue := cell^.NumberValue
-      else
-        case FDateMode of
-          dm1899: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1899_BASE;
-          dm1900: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1900_BASE;
-          dm1904: cell^.DateTimeValue := cell^.NumberValue + DATEMODE_1904_BASE;
-        end;
-    end;
-  end else
-  // 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
-  if (valueType = 'string') then begin
-    node := ACellNode.FindNode('text:p');
-    if (node <> nil) and (node.FirstChild <> nil) then begin
-      valueStr := node.FirstChild.Nodevalue;
-      FWorksheet.WriteUTF8Text(cell, valueStr);
-    end;
-  end else
-  // Text
-    FWorksheet.WriteUTF8Text(cell, valueStr);
-
-  if FIsVirtualMode then
-    Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
-end;
-
 procedure TsSpreadOpenDocReader.ReadLabel(ARow: Word; ACol: Word; ACellNode: TDOMNode);
 var
   cellText: String;
@@ -1424,29 +1447,6 @@ begin
     Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
 end;
 
-procedure TsSpreadOpenDocReader.ReadDateTime(ARow: Word; ACol: Word;
-  ACellNode : TDOMNode);
-var
-  dt: TDateTime;
-  styleName: String;
-  cell: PCell;
-begin
-  if FIsVirtualMode then begin
-    InitCell(ARow, ACol, FVirtualCell);
-    cell := @FVirtualCell;
-  end else
-    cell := FWorksheet.GetCell(ARow, ACol);
-
-  styleName := GetAttrValue(ACellNode, 'table:style-name');
-  ApplyStyleToCell(cell, stylename);
-
-  dt := ExtractDateTimeFromNode(ACellNode, cell^.NumberFormat, cell^.NumberFormatStr);
-  FWorkSheet.WriteDateTime(cell, dt, cell^.NumberFormat, cell^.NumberFormatStr);
-
-  if FIsVirtualMode then
-    Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
-end;
-
 procedure TsSpreadOpenDocReader.ReadNumFormats(AStylesNode: TDOMNode);
 
   procedure ReadStyleMap(ANode: TDOMNode; var ANumFormat: TsNumberFormat;
@@ -3627,27 +3627,36 @@ begin
     cctNumber:
       begin
         valuetype := 'float';
-        value := FormatFloat('%g', ACell^.NumberValue, FPointSeparatorSettings);
+        value := 'office:value="' + Format('%g', [ACell^.NumberValue], FPointSeparatorSettings) + '"';
       end;
     cctDateTime:
+      if trunc(ACell^.DateTimeValue) = 0 then
       begin
-        valuetype := 'float';
+        valuetype := 'time';
-        value := FormatFloat('%g', ACell^.DateTimeValue, FPointSeparatorSettings);
+        value := 'office:time-value="' + FormatDateTime(ISO8601FormatTimeOnly, ACell^.DateTimeValue) + '"';
+      end
+      else
+      begin
+        valuetype := 'date';
+        if frac(ACell^.DateTimeValue) = 0.0 then
+          value := 'office:date-value="' + FormatDateTime(ISO8601FormatDateOnly, ACell^.DateTimeValue) + '"'
+        else
+          value := 'office:date-value="' + FormatDateTime(ISO8601FormatExtended, ACell^.DateTimeValue) + '"';
       end;
     cctUTF8String:
       begin
         valuetype := 'string';
-        value := ACell^.UTF8StringValue;
+        value := 'office:string-value="' + ACell^.UTF8StringValue +'"';
       end;
     cctBool:
       begin
         valuetype := 'boolean';
-        value := BoolToStr(ACell^.BoolValue, 'true', 'false');
+        value := 'office:boolean-value="' + BoolToStr(ACell^.BoolValue, 'true', 'false') + '"';
       end;
     cctError:
       begin
         valuetype := 'error';
-        value := GetErrorValueStr(ACell^.ErrorValue);
+        value := 'office:value="' + GetErrorValueStr(ACell^.ErrorValue) + '"';
       end;
   end;
 
@@ -3658,11 +3667,11 @@ begin
     data type. Seems to work... }
   if ACell^.CalcState=csCalculated then
     AppendToStream(AStream, Format(
-      '<table:table-cell table:formula="=%s" office:value-type="%s" office-value="%s" %s>' +
+      '<table:table-cell table:formula="=%s" office:value-type="%s" %s %s>' +
-        '<text:p>%s</text:p>'+
+  //      '<text:p>%s</text:p>'+
       '</table:table-cell>', [
-      formula, valuetype, value, lStyle,
+      formula, valuetype, value, lStyle
-      value
+      //value
     ]))
   else
     AppendToStream(AStream, Format(

components/fpspreadsheet/fpspreadsheet.pas

@@ -2490,9 +2490,19 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell): ansistring;
     Result := '';
     if not IsNaN(Value) then
     begin
+      if (ANumberFormat = nfGeneral) then
+      begin
+        if frac(Value) = 0 then                 // date only
+          ANumberFormatStr := Workbook.FormatSettings.ShortDateFormat
+        else if trunc(Value) = 0 then           // time only
+          ANumberFormatStr := Workbook.FormatSettings.LongTimeFormat
+        else
+          ANumberFormatStr := 'cc'
+      end else
       if ANumberFormatStr = '' then
         ANumberFormatStr := BuildDateTimeFormatString(ANumberFormat,
           Workbook.FormatSettings, ANumberFormatStr);
+
       // Saw strange cases in ods where date/time formats contained pos/neg/zero parts.
       // Split to be on the safe side.
       SplitFormatString(ANumberFormatStr, fmtp, fmtn, fmt0);
@@ -3307,6 +3317,13 @@ begin
     // To make sure it gets saved correctly, set a date format (instead of General).
     // The user can choose another date format if he wants to
 
+    if AFormat = nfGeneral then begin
+      if trunc(AValue) = 0 then         // time only
+        AFormat := nfLongTime
+      else if frac(AValue) = 0.0 then   // date only
+        AFormat := nfShortDate;
+    end;
+
     if AFormatStr = '' then
       AFormatStr := BuildDateTimeFormatString(AFormat, Workbook.FormatSettings, AFormatStr)
     else

components/fpspreadsheet/fpsutils.pas

@@ -41,6 +41,8 @@ const
   ISO8601Format='yyyymmdd"T"hhmmss';
   {@@ Extended ISO 8601 date/time format, used in e.g. ODF/opendocument }
   ISO8601FormatExtended='yyyy"-"mm"-"dd"T"hh":"mm":"ss';
+  {@@  ISO 8601 date-only format, used in ODF/opendocument }
+  ISO8601FormatDateOnly='yyyy"-"mm"-"dd';
   {@@  ISO 8601 time-only format, used in ODF/opendocument }
   ISO8601FormatTimeOnly='"PT"hh"H"nn"M"ss"S"';
   {@@ ISO 8601 time-only format, with hours overflow }

components/fpspreadsheet/tests/formulatests.pas

@@ -59,6 +59,8 @@ type
     procedure Test_Write_Read_CalcRPNFormula_BIFF8;
     { OOXML Tests }
     procedure Test_Write_Read_CalcRPNFormula_OOXML;
+    { ODSL Tests }
+    procedure Test_Write_Read_CalcRPNFormula_ODS;
 
     // Writes out and calculates string formulas, read back
     { BIFF2 Tests }
@@ -69,6 +71,8 @@ type
     procedure Test_Write_Read_CalcStringFormula_BIFF8;
     { OOXML Tests }
     procedure Test_Write_Read_CalcStringFormula_OOXML;
+    { ODS Tests }
+    procedure Test_Write_Read_CalcStringFormula_ODS;
   end;
 
 implementation
@@ -189,7 +193,7 @@ end;
 
 procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS;
 begin
-  //TestWriteReadFormulaStrings(sfOpenDocument, true);
+  TestWriteReadFormulaStrings(sfOpenDocument, true);
 end;
 
 
@@ -357,6 +361,11 @@ begin
   TestCalcFormulas(sfOOXML, true);
 end;
 
+procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcRPNFormula_ODS;
+begin
+  TestCalcFormulas(sfOpenDocument, true);
+end;
+
 procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_BIFF2;
 begin
   TestCalcFormulas(sfExcel2, false);
@@ -377,6 +386,11 @@ begin
   TestCalcFormulas(sfOOXML, false);
 end;
 
+procedure TSpreadWriteReadFormulaTests.Test_Write_Read_CalcStringFormula_ODS;
+begin
+  TestCalcFormulas(sfOpenDocument, false);
+end;
+
 
 initialization
   // Register so these tests are included in a full run