freepascal.compiler/packages/fcl-base/tests/utcexprparsparser.pp

unit utcExprParsParser;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, punit, math, fpexprpars;

procedure RegisterTests;

implementation

uses typinfo;

type
  TMyFPExpressionParser = class(TFPExpressionParser)
  public
    property ExprNode;
    property Scanner;
    property Dirty;
  end;

var
  FP: TMyFPExpressionParser;
  FTestExpr: String;

procedure AssertLeftRight(N: TFPExprNode; LeftClass, RightClass: TClass);
begin
  AssertNotNull('Node should not be nil', N);
  AssertEquals('Node should be a binary operation', True, N is TFPBinaryOperation);
  if N is TFPBinaryOperation then
  begin
    AssertEquals('Left node class', LeftClass, TFPBinaryOperation(N).Left.ClassType);
    AssertEquals('Right node class', RightClass, TFPBinaryOperation(N).Right.ClassType);
  end;
end;

procedure AssertOperand(N: TFPExprNode; OperandClass: TClass);
begin
  AssertNotNull('Node should not be nil', N);
  AssertEquals('Node should be a unary operation', True, N is TFPUnaryOperator);
  if N is TFPUnaryOperator then
    AssertEquals('Operand node class', OperandClass, TFPUnaryOperator(N).Operand.ClassType);
end;

procedure AssertEqualsResultType(Msg: String; AExpected, AActual: TResultType);
begin
  AssertEquals(Msg, ResultTypeName(AExpected), ResultTypeName(AActual));
end;

procedure AssertResultType(RT: TResultType);
begin
  AssertEqualsResultType('Result type', RT, FP.ExprNode.NodeType);
end;

procedure AssertResult(F: TExprFloat);
begin
  AssertEquals('Float result', F, FP.AsFloat, 1E-9);
end;

procedure AssertCurrencyResult(C: Currency);
begin
  AssertEquals('Currency result', C, FP.AsCurrency, 1E-4);
end;

procedure AssertResult(I: Int64);
begin
  AssertEquals('Integer result', I, FP.AsInteger);
end;

procedure AssertResult(S: String);
begin
  AssertEquals('String result', S, FP.AsString);
end;

procedure AssertResult(B: Boolean);
begin
  AssertEquals('Boolean result', B, FP.AsBoolean);
end;

procedure AssertDateTimeResult(D: TDateTime);
begin
  AssertEquals('DateTime result', D, FP.AsDateTime);
end;

function Parser_Setup: string;
begin
  FP := TMyFPExpressionParser.Create(nil);
end;

function Parser_TearDown : string;
begin
  FreeAndNil(FP);
end;

procedure TestParser(AExpr: String);
begin
  FP.Expression := AExpr;
end;

function TestParserExpressions_TestCreate: TTestString;
begin
  Result := '';
  AssertNotNull('Parser created', FP);
end;

function TestParserExpressions_TestNumberValues: TTestString;
begin
  Result := '';
  TestParser('123');
  AssertResult(123);
  TestParser('123.456');
  AssertResult(123.456);
end;

// ... and so on for all the other test cases ...

procedure RegisterTests;
begin
  AddSuite('TParserExpressionsTests', @Parser_Setup, @Parser_TearDown);
  AddTest('TestCreate', @TestParserExpressions_TestCreate, 'TParserExpressionsTests');
  AddTest('TestNumberValues', @TestParserExpressions_TestNumberValues, 'TParserExpressionsTests');
  // ... and so on for all the other tests ...
end;

end.