View Issue Details

IDProjectCategoryView StatusLast Update
0033216FPCFCLpublic2018-02-24 12:00
ReporterSerge AnvarovAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.1.1Product Build 
Target Version3.2.0Fixed in Version3.1.1 
Summary0033216: TFPExpressionParser extension to support hexadecimal, octal, and binary integers
DescriptionTFPExpressionParser supports integers only in decimal format. Added support in other formats of numbers, for example $A5, &12, %101
Steps To Reproduceprogram Project1;
{$APPTYPE CONSOLE}
{$mode objfpc}{$H+}

uses fpexprpars;

var
  Parser: TFPExpressionParser;
begin
  Parser := TFPExpressionParser.Create(nil);
  try
    Parser.Expression := '11 + $A + &10 + %11 + 1e2';
    Writeln(Parser.AsFloat:0:2);
    Writeln(11 + $A + &10 + %11 + 1e2:0:2);
  finally
    Parser.Free;
  end;
  Readln;
end.
TagsNo tags attached.
Fixed in Revision38326
FPCOldBugId
FPCTarget
Attached Files
  • fpexprpars.diff (5,093 bytes)
    Index: packages/fcl-base/src/fpexprpars.pp
    ===================================================================
    --- packages/fcl-base/src/fpexprpars.pp	(revision 38321)
    +++ packages/fcl-base/src/fpexprpars.pp	(working copy)
    @@ -591,6 +591,7 @@
       TAggregateExpr = Class(TFPExprFunction)
       Protected
         FResult : TFPExpressionResult;
    +  public
         Class Function IsAggregate : Boolean; override;
         Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
       end;
    @@ -782,7 +783,7 @@
       cNull=#0;
       cSingleQuote = '''';
     
    -  Digits        = ['0'..'9','.'];
    +  Digits        = ['0'..'9','.','$','&', '%'];
       WhiteSpace    = [' ',#13,#10,#9];
       Operators     = ['+','-','<','>','=','/','*','^'];
       Delimiters    = Operators+[',','(',')'];
    @@ -804,7 +805,7 @@
       SErrInExpression = 'Cannot evaluate: error in expression';
       SErrInExpressionEmpty = 'Cannot evaluate: empty expression';
       SErrCommaExpected =  'Expected comma (,) at position %d, but got %s';
    -  SErrInvalidNumberChar = 'Unexpected character in number : %s';
    +//  SErrInvalidNumberChar = 'Unexpected character in number : %s';
       SErrInvalidNumber = 'Invalid numerical value : %s';
       SErrUnterminatedIdentifier = 'Unterminated quoted identifier: %s';
       SErrNoOperand = 'No operand for unary operation %s';
    @@ -813,7 +814,7 @@
       SErrNoNegation = 'Cannot negate expression of type %s : %s';
       SErrNoNOTOperation = 'Cannot perform "not" on expression of type %s: %s';
       SErrTypesDoNotMatch = 'Type mismatch: %s<>%s for expressions "%s" and "%s".';
    -  SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
    +//  SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
       SErrNoNodeToCheck = 'Internal error: No node to check !';
       SInvalidNodeType = 'Node type (%s) not in allowed types (%s) for expression: %s';
       SErrUnterminatedExpression = 'Badly terminated expression. Found token at position %d : %s';
    @@ -823,7 +824,7 @@
       SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s';
       SErrInvalidResultType = 'Invalid result type: %s';
       SErrNotVariable = 'Identifier %s is not a variable';
    -  SErrInactive = 'Operation not allowed while an expression is active';
    +//  SErrInactive = 'Operation not allowed while an expression is active';
       SErrIFNeedsBoolean = 'First argument to IF must be of type boolean: %s';
       SErrCaseNeeds3 = 'Case statement needs to have at least 4 arguments';
       SErrCaseEvenCount = 'Case statement needs to have an even number of arguments';
    @@ -1215,33 +1216,45 @@
         Result:=#0;
     end;
     
    -Function TFPExpressionScanner.DoNumber : TTokenType;
    +procedure Val(const S: string; out V: TExprFloat; out Code: Integer);
    +var
    +  L64: Int64;
    +begin
    +  if (S <> '') and (S[1] in ['&', '$', '%']) then
    +  begin
    +    System.Val(S, L64, Code);
    +    if Code = 0 then
    +      V := L64
    +  end
    +  else
    +    System.Val(S, V, Code);
    +end;
     
    -Var
    -  C : Char;
    -  X : TExprFloat;
    -  I : Integer;
    -  prevC: Char;
    -
    +function TFPExpressionScanner.DoNumber: TTokenType;
    +var
    +  V: TExprFloat;
    +  ErrPos: Integer;
    +  Len: Integer;
    +  S: string;
     begin
    -  C:=CurrentChar;
    -  prevC := #0;
    -  while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
    -    begin
    -    If Not ( IsDigit(C)
    -             or ((FToken<>'') and (Upcase(C)='E'))
    -             or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
    -           )
    -    then
    -      ScanError(Format(SErrInvalidNumberChar,[C]));
    -    FToken := FToken+C;
    -    prevC := Upcase(C);
    -    C:=NextPos;
    -    end;
    -  Val(FToken,X,I);
    -  If (I<>0) then
    -    ScanError(Format(SErrInvalidNumber,[FToken]));
    -  Result:=ttNumber;
    +  Len := Length(FChar);
    +  if Len > 255 then
    +    Len := 255;
    +  SetString(S, FChar, Len);
    +  // It is assumed that the first symbol is a digit
    +  Val(S, V, ErrPos);
    +  if ErrPos > 0 then
    +  begin
    +    Len := ErrPos - 1;
    +    SetLength(S, Len);
    +    Val(S, V, ErrPos);
    +  end;
    +  FToken := S;
    +  Inc(FPos, Len);
    +  Inc(FChar, Len);
    +  if ErrPos <> 0 then
    +    ScanError(Format(SErrInvalidNumber, [FToken]));
    +  Result := ttNumber;
     end;
     
     Function TFPExpressionScanner.DoIdentifier : TTokenType;
    @@ -1928,8 +1941,20 @@
       Items[AIndex]:=AValue;
     end;
     
    +{$PUSH}
    +{$WARN 5024 OFF : Parameter "$1" not used}
    +procedure NotUsed(Item: TCollectionItem); overload; inline;
    +begin
    +end;
    +
    +procedure NotUsed(const Args : TExprParameterArray); overload; inline;
    +begin
    +end;
    +{$POP}
    +
     procedure TFPExprIdentifierDefs.Update(Item: TCollectionItem);
     begin
    +  NotUsed(Item);
       If Assigned(FParser) then
         FParser.FDirty:=True;
     end;
    @@ -3708,16 +3733,19 @@
     
     Procedure BuiltInDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
     begin
    +  NotUsed(Args);
       Result.resDateTime:=Date;
     end;
     
     Procedure BuiltInTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
     begin
    +  NotUsed(Args);
       Result.resDateTime:=Time;
     end;
     
     Procedure BuiltInNow(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
     begin
    +  NotUsed(Args);
       Result.resDateTime:=Now;
     end;
     
    
    fpexprpars.diff (5,093 bytes)
  • wp-fpexprpars.pp.patch (4,692 bytes)
    Index: fcl-base/src/fpexprpars.pp
    ===================================================================
    --- fcl-base/src/fpexprpars.pp	(revision 38320)
    +++ fcl-base/src/fpexprpars.pp	(working copy)
    @@ -47,6 +47,8 @@
       TFPExprFunction = Class;
       TFPExprFunctionClass = Class of TFPExprFunction;
     
    +  TNumberKind = (nkDecimal, nkHex, nkOctal, nkBinary);
    +
       { TFPExpressionScanner }
     
       TFPExpressionScanner = Class(TObject)
    @@ -62,7 +64,7 @@
       protected
         procedure SetSource(const AValue: String); virtual;
         function DoIdentifier: TTokenType;
    -    function DoNumber: TTokenType;
    +    function DoNumber(AKind: TNumberKind): TTokenType;
         function DoDelimiter: TTokenType;
         function DoString: TTokenType;
         Function NextPos : Char; // inline;
    @@ -69,7 +71,7 @@
         procedure SkipWhiteSpace; // inline;
         function IsWordDelim(C : Char) : Boolean; // inline;
         function IsDelim(C : Char) : Boolean; // inline;
    -    function IsDigit(C : Char) : Boolean; // inline;
    +    function IsDigit(C : Char; AKind: TNumberKind) : Boolean; // inline;
         function IsAlpha(C : Char) : Boolean; // inline;
       public
         Constructor Create;
    @@ -591,6 +593,7 @@
       TAggregateExpr = Class(TFPExprFunction)
       Protected
         FResult : TFPExpressionResult;
    +  public
         Class Function IsAggregate : Boolean; override;
         Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
       end;
    @@ -781,8 +784,14 @@
     const
       cNull=#0;
       cSingleQuote = '''';
    +  cHexIdentifier = '$';
    +  cOctalIdentifier = '&';
    +  cBinaryIdentifier = '%';
     
       Digits        = ['0'..'9','.'];
    +  HexDigits     = ['0'..'9', 'A'..'F', 'a'..'f'];
    +  OctalDigits   = ['0'..'7'];
    +  BinaryDigits  = ['0', '1'];
       WhiteSpace    = [' ',#13,#10,#9];
       Operators     = ['+','-','<','>','=','/','*','^'];
       Delimiters    = Operators+[',','(',')'];
    @@ -1115,9 +1124,14 @@
       Result:=C in Delimiters;
     end;
     
    -function TFPExpressionScanner.IsDigit(C: Char): Boolean;
    +function TFPExpressionScanner.IsDigit(C: Char; AKind: TNumberKind): Boolean;
     begin
    -  Result:=C in Digits;
    +  case AKind of
    +    nkDecimal: Result := C in Digits;
    +    nkHex    : Result := C in HexDigits;
    +    nkOctal  : Result := C in OctalDigits;
    +    nkBinary : Result := C in BinaryDigits;
    +  end;
     end;
     
     Procedure TFPExpressionScanner.SkipWhiteSpace;
    @@ -1215,8 +1229,22 @@
         Result:=#0;
     end;
     
    -Function TFPExpressionScanner.DoNumber : TTokenType;
    +procedure Val(const S: string; out V: TExprFloat; out Code: Integer);
    +var
    +  L64: Int64;
    +begin
    +  if (S <> '') and (S[1] in ['&', '$', '%']) then
    +  begin
    +    System.Val(S, L64, Code);
    +    if Code = 0 then
    +      V := L64
    +  end
    +  else
    +    System.Val(S, V, Code);
    +end;
     
    +Function TFPExpressionScanner.DoNumber(AKind: TNumberKind) : TTokenType;
    +
     Var
       C : Char;
       X : TExprFloat;
    @@ -1223,16 +1251,38 @@
       I : Integer;
       prevC: Char;
     
    +  function ValidDigit(C: Char; AKind: TNumberKind): Boolean;
    +  begin
    +    Result := IsDigit(C, AKind);
    +    if (not Result) then
    +      case AKind of
    +        nkDecimal:
    +          Result := ((FToken <> '') and (UpCase(C)='E')) or
    +                    ((FToken <> '') and (C in ['+','-']) and (prevC='E'));
    +        nkHex:
    +          Result := (C = cHexIdentifier) and (prevC = #0);
    +        nkOctal:
    +          Result := (C = cOctalIdentifier) and (prevC = #0);
    +        nkBinary:
    +          Result := (C = cBinaryIdentifier) and (prevC = #0);
    +      end;
    +  end;
    +
     begin
       C:=CurrentChar;
       prevC := #0;
    -  while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
    -    begin
    -    If Not ( IsDigit(C)
    -             or ((FToken<>'') and (Upcase(C)='E'))
    -             or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
    -           )
    -    then
    +  while (C <> cNull) do
    +  begin
    +    if IsWordDelim(C) then
    +      case AKind of
    +        nkDecimal:
    +          if not (prevC in ['E','-','+']) then break;
    +        nkHex, nkOctal:
    +          break;
    +        nkBinary:
    +          if (prevC <> #0) then break;   // allow '%' as first char
    +      end;
    +    if not ValidDigit(C, AKind) then
           ScanError(Format(SErrInvalidNumberChar,[C]));
         FToken := FToken+C;
         prevC := Upcase(C);
    @@ -1306,8 +1356,14 @@
         Result:=DoDelimiter
       else if (C=cSingleQuote) then
         Result:=DoString
    -  else if IsDigit(C) then
    -    Result:=DoNumber
    +  else if (C=cHexIdentifier) then
    +    Result := DoNumber(nkHex)
    +  else if (C=cOctalIdentifier) then
    +    Result := DoNumber(nkOctal)
    +  else if (C=cBinaryIdentifier) then
    +    Result := DoNumber(nkBinary)
    +  else if IsDigit(C, nkDecimal) then
    +    Result:=DoNumber(nkDecimal)
       else if IsAlpha(C) or (C='"') then
         Result:=DoIdentifier
       else
    
    wp-fpexprpars.pp.patch (4,692 bytes)

Activities

Serge Anvarov

2018-02-24 09:44

reporter  

fpexprpars.diff (5,093 bytes)
Index: packages/fcl-base/src/fpexprpars.pp
===================================================================
--- packages/fcl-base/src/fpexprpars.pp	(revision 38321)
+++ packages/fcl-base/src/fpexprpars.pp	(working copy)
@@ -591,6 +591,7 @@
   TAggregateExpr = Class(TFPExprFunction)
   Protected
     FResult : TFPExpressionResult;
+  public
     Class Function IsAggregate : Boolean; override;
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
   end;
@@ -782,7 +783,7 @@
   cNull=#0;
   cSingleQuote = '''';
 
-  Digits        = ['0'..'9','.'];
+  Digits        = ['0'..'9','.','$','&', '%'];
   WhiteSpace    = [' ',#13,#10,#9];
   Operators     = ['+','-','<','>','=','/','*','^'];
   Delimiters    = Operators+[',','(',')'];
@@ -804,7 +805,7 @@
   SErrInExpression = 'Cannot evaluate: error in expression';
   SErrInExpressionEmpty = 'Cannot evaluate: empty expression';
   SErrCommaExpected =  'Expected comma (,) at position %d, but got %s';
-  SErrInvalidNumberChar = 'Unexpected character in number : %s';
+//  SErrInvalidNumberChar = 'Unexpected character in number : %s';
   SErrInvalidNumber = 'Invalid numerical value : %s';
   SErrUnterminatedIdentifier = 'Unterminated quoted identifier: %s';
   SErrNoOperand = 'No operand for unary operation %s';
@@ -813,7 +814,7 @@
   SErrNoNegation = 'Cannot negate expression of type %s : %s';
   SErrNoNOTOperation = 'Cannot perform "not" on expression of type %s: %s';
   SErrTypesDoNotMatch = 'Type mismatch: %s<>%s for expressions "%s" and "%s".';
-  SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
+//  SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".';
   SErrNoNodeToCheck = 'Internal error: No node to check !';
   SInvalidNodeType = 'Node type (%s) not in allowed types (%s) for expression: %s';
   SErrUnterminatedExpression = 'Badly terminated expression. Found token at position %d : %s';
@@ -823,7 +824,7 @@
   SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s';
   SErrInvalidResultType = 'Invalid result type: %s';
   SErrNotVariable = 'Identifier %s is not a variable';
-  SErrInactive = 'Operation not allowed while an expression is active';
+//  SErrInactive = 'Operation not allowed while an expression is active';
   SErrIFNeedsBoolean = 'First argument to IF must be of type boolean: %s';
   SErrCaseNeeds3 = 'Case statement needs to have at least 4 arguments';
   SErrCaseEvenCount = 'Case statement needs to have an even number of arguments';
@@ -1215,33 +1216,45 @@
     Result:=#0;
 end;
 
-Function TFPExpressionScanner.DoNumber : TTokenType;
+procedure Val(const S: string; out V: TExprFloat; out Code: Integer);
+var
+  L64: Int64;
+begin
+  if (S <> '') and (S[1] in ['&', '$', '%']) then
+  begin
+    System.Val(S, L64, Code);
+    if Code = 0 then
+      V := L64
+  end
+  else
+    System.Val(S, V, Code);
+end;
 
-Var
-  C : Char;
-  X : TExprFloat;
-  I : Integer;
-  prevC: Char;
-
+function TFPExpressionScanner.DoNumber: TTokenType;
+var
+  V: TExprFloat;
+  ErrPos: Integer;
+  Len: Integer;
+  S: string;
 begin
-  C:=CurrentChar;
-  prevC := #0;
-  while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
-    begin
-    If Not ( IsDigit(C)
-             or ((FToken<>'') and (Upcase(C)='E'))
-             or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
-           )
-    then
-      ScanError(Format(SErrInvalidNumberChar,[C]));
-    FToken := FToken+C;
-    prevC := Upcase(C);
-    C:=NextPos;
-    end;
-  Val(FToken,X,I);
-  If (I<>0) then
-    ScanError(Format(SErrInvalidNumber,[FToken]));
-  Result:=ttNumber;
+  Len := Length(FChar);
+  if Len > 255 then
+    Len := 255;
+  SetString(S, FChar, Len);
+  // It is assumed that the first symbol is a digit
+  Val(S, V, ErrPos);
+  if ErrPos > 0 then
+  begin
+    Len := ErrPos - 1;
+    SetLength(S, Len);
+    Val(S, V, ErrPos);
+  end;
+  FToken := S;
+  Inc(FPos, Len);
+  Inc(FChar, Len);
+  if ErrPos <> 0 then
+    ScanError(Format(SErrInvalidNumber, [FToken]));
+  Result := ttNumber;
 end;
 
 Function TFPExpressionScanner.DoIdentifier : TTokenType;
@@ -1928,8 +1941,20 @@
   Items[AIndex]:=AValue;
 end;
 
+{$PUSH}
+{$WARN 5024 OFF : Parameter "$1" not used}
+procedure NotUsed(Item: TCollectionItem); overload; inline;
+begin
+end;
+
+procedure NotUsed(const Args : TExprParameterArray); overload; inline;
+begin
+end;
+{$POP}
+
 procedure TFPExprIdentifierDefs.Update(Item: TCollectionItem);
 begin
+  NotUsed(Item);
   If Assigned(FParser) then
     FParser.FDirty:=True;
 end;
@@ -3708,16 +3733,19 @@
 
 Procedure BuiltInDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
+  NotUsed(Args);
   Result.resDateTime:=Date;
 end;
 
 Procedure BuiltInTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
+  NotUsed(Args);
   Result.resDateTime:=Time;
 end;
 
 Procedure BuiltInNow(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
+  NotUsed(Args);
   Result.resDateTime:=Now;
 end;
 
fpexprpars.diff (5,093 bytes)

Serge Anvarov

2018-02-24 09:46

reporter   ~0106554

At the request of the forum https://forum.lazarus.freepascal.org/index.php/topic,40200.msg277451.html#msg277451

wp

2018-02-24 10:44

reporter  

wp-fpexprpars.pp.patch (4,692 bytes)
Index: fcl-base/src/fpexprpars.pp
===================================================================
--- fcl-base/src/fpexprpars.pp	(revision 38320)
+++ fcl-base/src/fpexprpars.pp	(working copy)
@@ -47,6 +47,8 @@
   TFPExprFunction = Class;
   TFPExprFunctionClass = Class of TFPExprFunction;
 
+  TNumberKind = (nkDecimal, nkHex, nkOctal, nkBinary);
+
   { TFPExpressionScanner }
 
   TFPExpressionScanner = Class(TObject)
@@ -62,7 +64,7 @@
   protected
     procedure SetSource(const AValue: String); virtual;
     function DoIdentifier: TTokenType;
-    function DoNumber: TTokenType;
+    function DoNumber(AKind: TNumberKind): TTokenType;
     function DoDelimiter: TTokenType;
     function DoString: TTokenType;
     Function NextPos : Char; // inline;
@@ -69,7 +71,7 @@
     procedure SkipWhiteSpace; // inline;
     function IsWordDelim(C : Char) : Boolean; // inline;
     function IsDelim(C : Char) : Boolean; // inline;
-    function IsDigit(C : Char) : Boolean; // inline;
+    function IsDigit(C : Char; AKind: TNumberKind) : Boolean; // inline;
     function IsAlpha(C : Char) : Boolean; // inline;
   public
     Constructor Create;
@@ -591,6 +593,7 @@
   TAggregateExpr = Class(TFPExprFunction)
   Protected
     FResult : TFPExpressionResult;
+  public
     Class Function IsAggregate : Boolean; override;
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
   end;
@@ -781,8 +784,14 @@
 const
   cNull=#0;
   cSingleQuote = '''';
+  cHexIdentifier = '$';
+  cOctalIdentifier = '&';
+  cBinaryIdentifier = '%';
 
   Digits        = ['0'..'9','.'];
+  HexDigits     = ['0'..'9', 'A'..'F', 'a'..'f'];
+  OctalDigits   = ['0'..'7'];
+  BinaryDigits  = ['0', '1'];
   WhiteSpace    = [' ',#13,#10,#9];
   Operators     = ['+','-','<','>','=','/','*','^'];
   Delimiters    = Operators+[',','(',')'];
@@ -1115,9 +1124,14 @@
   Result:=C in Delimiters;
 end;
 
-function TFPExpressionScanner.IsDigit(C: Char): Boolean;
+function TFPExpressionScanner.IsDigit(C: Char; AKind: TNumberKind): Boolean;
 begin
-  Result:=C in Digits;
+  case AKind of
+    nkDecimal: Result := C in Digits;
+    nkHex    : Result := C in HexDigits;
+    nkOctal  : Result := C in OctalDigits;
+    nkBinary : Result := C in BinaryDigits;
+  end;
 end;
 
 Procedure TFPExpressionScanner.SkipWhiteSpace;
@@ -1215,8 +1229,22 @@
     Result:=#0;
 end;
 
-Function TFPExpressionScanner.DoNumber : TTokenType;
+procedure Val(const S: string; out V: TExprFloat; out Code: Integer);
+var
+  L64: Int64;
+begin
+  if (S <> '') and (S[1] in ['&', '$', '%']) then
+  begin
+    System.Val(S, L64, Code);
+    if Code = 0 then
+      V := L64
+  end
+  else
+    System.Val(S, V, Code);
+end;
 
+Function TFPExpressionScanner.DoNumber(AKind: TNumberKind) : TTokenType;
+
 Var
   C : Char;
   X : TExprFloat;
@@ -1223,16 +1251,38 @@
   I : Integer;
   prevC: Char;
 
+  function ValidDigit(C: Char; AKind: TNumberKind): Boolean;
+  begin
+    Result := IsDigit(C, AKind);
+    if (not Result) then
+      case AKind of
+        nkDecimal:
+          Result := ((FToken <> '') and (UpCase(C)='E')) or
+                    ((FToken <> '') and (C in ['+','-']) and (prevC='E'));
+        nkHex:
+          Result := (C = cHexIdentifier) and (prevC = #0);
+        nkOctal:
+          Result := (C = cOctalIdentifier) and (prevC = #0);
+        nkBinary:
+          Result := (C = cBinaryIdentifier) and (prevC = #0);
+      end;
+  end;
+
 begin
   C:=CurrentChar;
   prevC := #0;
-  while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
-    begin
-    If Not ( IsDigit(C)
-             or ((FToken<>'') and (Upcase(C)='E'))
-             or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
-           )
-    then
+  while (C <> cNull) do
+  begin
+    if IsWordDelim(C) then
+      case AKind of
+        nkDecimal:
+          if not (prevC in ['E','-','+']) then break;
+        nkHex, nkOctal:
+          break;
+        nkBinary:
+          if (prevC <> #0) then break;   // allow '%' as first char
+      end;
+    if not ValidDigit(C, AKind) then
       ScanError(Format(SErrInvalidNumberChar,[C]));
     FToken := FToken+C;
     prevC := Upcase(C);
@@ -1306,8 +1356,14 @@
     Result:=DoDelimiter
   else if (C=cSingleQuote) then
     Result:=DoString
-  else if IsDigit(C) then
-    Result:=DoNumber
+  else if (C=cHexIdentifier) then
+    Result := DoNumber(nkHex)
+  else if (C=cOctalIdentifier) then
+    Result := DoNumber(nkOctal)
+  else if (C=cBinaryIdentifier) then
+    Result := DoNumber(nkBinary)
+  else if IsDigit(C, nkDecimal) then
+    Result:=DoNumber(nkDecimal)
   else if IsAlpha(C) or (C='"') then
     Result:=DoIdentifier
   else
wp-fpexprpars.pp.patch (4,692 bytes)

wp

2018-02-24 10:44

reporter   ~0106556

I am attaching my own patch which more closely follows the strategy of the expression scanner.

This is my test program:

program Project1;

{$mode objfpc}{$H+}

uses
  fpexprpars;

var
  parser: TFPExpressionParser;
  x, res: Integer;
  expr: String;

  procedure DoTest(AExpression: String; Expected: Integer);
  var
    res: TFPExpressionResult;
  begin
    Write(AExpression, ' = ');
    parser.Expression := AExpression;
    res := parser.Evaluate;
    case res.ResultType of
      rtInteger:
        Write(res.ResInteger);
      rtFloat:
        Write(res.ResFloat:0:3);
      else
        WriteLn('Unexpected result type');
        exit;
    end;

    if ArgToFloat(res) = Expected then
      WriteLn
    else
      WriteLn(' --> ERROR (expected ', Expected, ')');
  end;

begin
  parser := TFPExpressionParser.Create(nil);
  try
    // Decimal numbers
    DoTest('1', 1);
    DoTest('1E2', 100);
    DoTest('1.0/1E-2', 100);
// DoTest('200%', 2);
    WriteLn;
    // Hex numbers
    DoTest('$0001', 1);
    DoTest('-$01', -1);
    DoTest('$A', 10);
    DoTest('$FF', 255);
    DoTest('$fe', 254);
    DoTest('$FFFF', $FFFF);
    DoTest('1E2', 100);
    DoTest('$E', 14);
    DoTest('$D+1E2', 113);
    DoTest('$0A-$0B', -1);
    // Hex and variables
    parser.Identifiers.AddVariable('a', rtInteger, '1');
    parser.Identifiers.AddVariable('b', rtInteger, '$B');
    DoTest('a', 1);
    DoTest('b', $B);
    DoTest('$A+a', 11);
    DoTest('$B-b', 0);
    WriteLn;
    // Octal numbers
    DoTest('&10', 8);
    DoTest('&10+10', 18);
    // Mixed hex and octal expression
    DoTest('&10-$0008', 0);
    WriteLn;
    // Binary numbers
    DoTest('%1', 1);
    DoTest('%11', 3);
    DoTest('%1000', 8);
  finally
    parser.Free;
  end;

  WriteLn;
  WriteLn('Done. Press ENTER to close...');
  ReadLn;
end.

Michael Van Canneyt

2018-02-24 12:00

administrator   ~0106560

Applied WP's patch, added his tests to the testsuite.

Thanks to both of you for enabling this !

Issue History

Date Modified Username Field Change
2018-02-24 09:44 Serge Anvarov New Issue
2018-02-24 09:44 Serge Anvarov File Added: fpexprpars.diff
2018-02-24 09:46 Serge Anvarov Note Added: 0106554
2018-02-24 10:44 wp File Added: wp-fpexprpars.pp.patch
2018-02-24 10:44 wp Note Added: 0106556
2018-02-24 12:00 Michael Van Canneyt Fixed in Revision => 38326
2018-02-24 12:00 Michael Van Canneyt Note Added: 0106560
2018-02-24 12:00 Michael Van Canneyt Status new => resolved
2018-02-24 12:00 Michael Van Canneyt Fixed in Version => 3.1.1
2018-02-24 12:00 Michael Van Canneyt Resolution open => fixed
2018-02-24 12:00 Michael Van Canneyt Assigned To => Michael Van Canneyt
2018-02-24 12:00 Michael Van Canneyt Target Version => 3.2.0