fpspreadsheet: Add support for missing arguments to formula parser.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4179 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-06-06 11:53:47 +00:00
parent 40644ea5d5
commit 5d6bea6a85

View File

@ -61,7 +61,7 @@ type
ttCell, ttCellRange, ttNumber, ttString, ttIdentifier, ttCell, ttCellRange, ttNumber, ttString, ttIdentifier,
ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight, ttPlus, ttMinus, ttMul, ttDiv, ttConcat, ttPercent, ttPower, ttLeft, ttRight,
ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual, ttLessThan, ttLargerThan, ttEqual, ttNotEqual, ttLessThanEqual, ttLargerThanEqual,
ttListSep, ttTrue, ttFalse, ttError, ttEOF ttListSep, ttTrue, ttFalse, ttMissingArg, ttError, ttEOF
); );
TsExprFloat = Double; TsExprFloat = Double;
@ -84,7 +84,7 @@ type
TsFormulaDialect = (fdExcel, fdOpenDocument); TsFormulaDialect = (fdExcel, fdOpenDocument);
TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString, TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
rtCell, rtCellRange, rtHyperlink, rtError, rtAny); rtCell, rtCellRange, rtHyperlink, rtError, rtMissingArg, rtAny);
TsResultTypes = set of TsResultType; TsResultTypes = set of TsResultType;
TsExpressionResult = record TsExpressionResult = record
@ -410,6 +410,15 @@ type
property ConstValue: TsExpressionResult read FValue; property ConstValue: TsExpressionResult read FValue;
end; end;
{ TsMissingArgExprNode }
TsMissingArgExprNode = class(TsExprNode)
protected
procedure GetNodeValue(out Result: TsExpressionResult); override;
function AsString: String; override;
function AsRPNItem(ANext: PRPNItem): PRPNItem; override;
function NodeType: TsResultType; override;
end;
TsExprIdentifierType = (itVariable, itFunctionCallBack, itFunctionHandler); TsExprIdentifierType = (itVariable, itFunctionCallBack, itFunctionHandler);
TsExprFunctionCallBack = procedure (var Result: TsExpressionResult; TsExprFunctionCallBack = procedure (var Result: TsExpressionResult;
@ -1666,6 +1675,7 @@ var
AI: Integer; AI: Integer;
optional: Boolean; optional: Boolean;
token: String; token: String;
prevTokenType: TsTokenType;
begin begin
{$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} {$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
SetLength(Args, 0); SetLength(Args, 0);
@ -1692,7 +1702,7 @@ begin
else if (TokenType = ttCellRange) then else if (TokenType = ttCellRange) then
Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken) Result := TsCellRangeExprNode.Create(self, FWorksheet, CurrentToken)
else if (TokenType = ttError) then else if (TokenType = ttError) then
Result := tsConstExprNode.CreateError(self, CurrentToken) Result := TsConstExprNode.CreateError(self, CurrentToken)
else if not (TokenType in [ttIdentifier]) then else if not (TokenType in [ttIdentifier]) then
ParserError(Format(SerrUnknownTokenAtPos, [Scanner.Pos, CurrentToken])) ParserError(Format(SerrUnknownTokenAtPos, [Scanner.Pos, CurrentToken]))
else else
@ -1729,6 +1739,7 @@ begin
AI := 0; AI := 0;
try try
repeat repeat
prevTokenType := TokenType;
GetToken; GetToken;
// Check if we must enlarge the argument array // Check if we must enlarge the argument array
if (lCount < 0) and (AI = Length(Args)) then if (lCount < 0) and (AI = Length(Args)) then
@ -1736,6 +1747,12 @@ begin
SetLength(Args, AI+1); SetLength(Args, AI+1);
Args[AI] := nil; Args[AI] := nil;
end; end;
if (prevTokenType in [ttLeft, ttListSep]) and (TokenType in [ttListSep, ttRight]) then
begin
Args[AI] := TsMissingArgExprNode.Create;
inc(AI);
Continue;
end;
Args[AI] := Level1; Args[AI] := Level1;
inc(AI); inc(AI);
optional := ID.IsOptionalArgument(AI+1); optional := ID.IsOptionalArgument(AI+1);
@ -1912,6 +1929,11 @@ procedure TsExpressionParser.SetRPNFormula(const AFormula: TsRPNFormula);
ANode := TsConstExprNode.CreateError(self, TsErrorValue(AFormula[AIndex].IntValue)); ANode := TsConstExprNode.CreateError(self, TsErrorValue(AFormula[AIndex].IntValue));
dec(AIndex); dec(AIndex);
end; end;
fekMissingArg:
begin
ANode := TsMissingArgExprNode.Create;
dec(AIndex);
end;
// unary operations // unary operations
fekPercent, fekUMinus, fekUPlus, fekParen: fekPercent, fekUMinus, fekUPlus, fekParen:
@ -2699,6 +2721,8 @@ begin
err := errIllegalRef err := errIllegalRef
else if AVAlue = '#NAME?' then else if AVAlue = '#NAME?' then
err := errWrongName err := errWrongName
else if AValue = '#N/A' then
err := errArgError
else if AValue = '#FORMULA?' then else if AValue = '#FORMULA?' then
err := errFormulaNotSupported err := errFormulaNotSupported
else else
@ -2746,6 +2770,28 @@ begin
end; end;
{ TsMissingExprNode }
function TsMissingArgExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
begin
Result := RPNMissingARg(ANext);
end;
function TsMissingArgExprNode.AsString: String;
begin
Result := '';
end;
procedure TsMissingArgExprNode.GetNodeValue(out Result: TsExpressionResult);
begin
Result.ResultType := rtMissingArg;
end;
function TsMissingArgExprNode.NodeType: TsResultType;
begin
Result := rtMissingArg;
end;
{ TsUPlusExprNode } { TsUPlusExprNode }
function TsUPlusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem; function TsUPlusExprNode.AsRPNItem(ANext: PRPNItem): PRPNItem;
@ -3675,7 +3721,8 @@ begin
begin begin
if (S <> '') then if (S <> '') then
S := S + Parser.FFormatSettings.ListSeparator; S := S + Parser.FFormatSettings.ListSeparator;
S := S + FArgumentNodes[i].AsString; if Assigned(FArgumentNodes[i]) then
S := S + FArgumentNodes[i].AsString;
end; end;
S := '(' + S + ')'; S := '(' + S + ')';
Result := FID.Name + S; Result := FID.Name + S;
@ -3716,6 +3763,9 @@ begin
for i := 0 to Length(FArgumentNodes)-1 do for i := 0 to Length(FArgumentNodes)-1 do
begin begin
if FArgumentNodes[i] = nil then
Continue;
rta := FArgumentNodes[i].NodeType; rta := FArgumentNodes[i].NodeType;
if i+1 <= Length(FID.ParameterTypes) then if i+1 <= Length(FID.ParameterTypes) then