* Expression parsing tests, nested types

git-svn-id: trunk@22144 -

.gitattributes

@@ -2328,6 +2328,7 @@ packages/fcl-passrc/src/pscanner.pp svneol=native#text/plain
 packages/fcl-passrc/src/readme.txt svneol=native#text/plain
 packages/fcl-passrc/tests/tcbaseparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcclasstype.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcexprparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain

packages/fcl-passrc/src/pastree.pp

@@ -192,6 +192,7 @@ type
   { TInheritedExpr }
 
   TInheritedExpr = class(TPasExpr)
+  Public
     constructor Create(AParent : TPasElement); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
@@ -492,7 +493,7 @@ type
     Members: TFPList;     // array of TPasVariable elements
     VariantName: string;
     VariantType: TPasType;
-    Variants: TFPList;  // array of TPasVariant elements, may be nil!
+    Variants: TFPList;	// array of TPasVariant elements, may be nil!
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
   end;
@@ -616,7 +617,7 @@ type
   end;
 
   { TPasVariable }
-  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport);
+  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass);
   TVariableModifiers = set of TVariableModifier;
 
   TPasVariable = class(TPasElement)
@@ -692,7 +693,7 @@ type
 
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExported, pmOverload, pmMessage, pmReintroduce,
-                        pmStatic,pmInline,pmAssembler,pmVarargs,
+                        pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
                         pmCompilerProc,pmExternal,pmForward);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtInteger,pmtString);
@@ -1023,11 +1024,12 @@ type
   end;
 
   { TPasImplAssign }
-
+  TAssignKind = (akDefault,akAdd,akMinus,akMul,akDivision);
   TPasImplAssign = class (TPasImplStatement)
   public
     left  : TPasExpr;
     right : TPasExpr;
+    Kind : TAssignKind;
     Destructor Destroy; override;
   end;
 
@@ -1136,6 +1138,7 @@ const
   cCallingConventions : array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall');
 
+
 implementation
 
 uses SysUtils;
@@ -1203,7 +1206,6 @@ begin
     Result:=Result+' name '+ExportName.GetDeclaration(Full)
   else if (ExportIndex<>Nil) then
     Result:=Result+' index '+ExportIndex.GetDeclaration(Full);
-
 end;
 
 { TPasUnresolvedUnitRef }
@@ -3225,7 +3227,7 @@ end;
 
 { TInheritedExpr }
 
-Function TInheritedExpr.GetDeclaration(Full :Boolean):AnsiString;
+function TInheritedExpr.GetDeclaration(full: Boolean): string;
 begin
   Result:='Inherited';
 end;
@@ -3291,6 +3293,7 @@ begin
   inherited Create(AParent,pekInherited, eopNone);
 end;
 
+
 { TSelfExpr }
 
 constructor TSelfExpr.Create(AParent : TPasElement);

packages/fcl-passrc/src/pparser.pp

@@ -135,6 +135,7 @@ type
     function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
+    procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
@@ -144,7 +145,7 @@ type
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
-    procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility);
+    procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
@@ -160,7 +161,7 @@ type
     Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
     Function IsCurTokenHint: Boolean; overload;
     Function TokenIsCallingConvention(S : String; out CC : TCallingConvention) : Boolean; virtual;
-    Function TokenIsProcedureModifier(S : String; Out Pm : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsProcedureModifier(Parent : TPasElement; S : String; Out Pm : TProcedureModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
     function ParseParams(AParent : TPasElement;paramskind: TPasExprKind): TParamsExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
@@ -308,7 +309,7 @@ Const
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
                    'exported', 'overload', 'message', 'reintroduce',
-                   'static','inline','assembler','varargs',
+                   'static','inline','assembler','varargs', 'public',
                    'compilerproc','external','forward');
 
 Var
@@ -368,19 +369,16 @@ var
       case s[2] of
         'd': // -d define
           Scanner.AddDefine(UpperCase(Copy(s, 3, Length(s))));
-        'S': // -d define
-          case S[3] of
-            'c' :Scanner.Options:=Scanner.Options+[c_assignments];
-          end;
         'F': // -F
           if (length(s)>2) and (s[3] = 'i') then // -Fi include path
             FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
         'I': // -I include path
           FileResolver.AddIncludePath(Copy(s, 3, Length(s)));
         'S': // -S mode
-          if  (length(s)>2) and (s[3]='d') then
-            begin // -Sd mode delphi
-              Parser.Options:=Parser.Options+[po_delphi];
+          if  (length(s)>2) then
+            case S[3] of
+              'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
+              'd' : Parser.Options:=Parser.Options+[po_delphi];
             end;
       end;
     end else
@@ -658,9 +656,15 @@ begin
   Result:=IsCallingConvention(S,CC);
 end;
 
-function TPasParser.TokenIsProcedureModifier(S: String; out Pm: TProcedureModifier): Boolean;
+function TPasParser.TokenIsProcedureModifier(Parent : TPasElement; S: String; out Pm: TProcedureModifier): Boolean;
 begin
   Result:=IsModifier(S,PM);
+  if result and (pm=pmPublic)then
+    begin
+    While (Parent<>Nil) and Not (Parent is TPasClassType) do
+     Parent:=Parent.Parent;
+    Result:=Not Assigned(Parent);
+    end;
 end;
 
 
@@ -1142,11 +1146,13 @@ begin
     tkfalse, tktrue:    x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
     tknil:              x:=TNilExpr.Create(Aparent);
     tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
-    tkinherited: begin
+    tkinherited:
+      begin
       //inherited; inherited function
       x:=TInheritedExpr.Create(AParent);
       NextToken;
-      if (length(CurTokenText)>0) and (CurTokenText[1] in ['A'..'_']) then begin
+      if (CurToken=tkIdentifier) then
+        begin
         b:=TBinaryExpr.Create(AParent,x, DoParseExpression(AParent), eopNone);
         if not Assigned(b.right) then
           begin
@@ -1155,9 +1161,10 @@ begin
           end;
         x:=b;
         UngetToken;
-      end
-       else UngetToken;
-    end;
+        end
+      else
+        UngetToken;
+      end;
     tkself: begin
       //x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
       x:=TSelfExpr.Create(AParent);
@@ -2231,7 +2238,7 @@ begin
   if Result then
     begin
     NextToken;
-    Value := DoParseExpression(Parent);
+    Value := DoParseConstValueExpression(Parent);
 //    NextToken;
     end;
   if (CurToken=tkAbsolute) then
@@ -2548,7 +2555,7 @@ Var
 begin
   if parent is TPasProcedure then
     TPasProcedure(Parent).AddModifier(pm);
-  if pm=pmExternal then
+  if (pm=pmExternal) then
     begin
     NextToken;
     if CurToken in [tkString,tkIdentifier] then
@@ -2570,6 +2577,23 @@ begin
     else
       UngetToken;
     end
+  else if (pm = pmPublic) then
+    begin
+    NextToken;
+    { Should be token Name,
+      if not we're in a class and the public section starts }
+    If (Uppercase(CurTokenString)<>'NAME') then
+      begin
+      UngetToken;
+      UngetToken;
+      exit;
+      end
+    else
+      begin
+      NextToken;  // Should be export name string.
+      ExpectToken(tkSemicolon);
+      end;
+    end
   else if pm=pmForward then
     begin
     if (Parent.Parent is TInterfaceSection) then
@@ -2643,7 +2667,6 @@ begin
         TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
       else
         ParseType(nil);
-      Writeln('Function : ',TokenInfos[Curtoken],' ',CurtokenString);
       end;
     ptOperator:
       begin
@@ -2699,38 +2722,22 @@ begin
         Element.CallingConvention:=Cc;
       ExpectToken(tkSemicolon);
       end
-    else if TokenIsProcedureModifier(CurTokenString,pm) then
+    else if TokenIsProcedureModifier(Parent,CurTokenString,pm) then
       HandleProcedureModifier(Parent,Pm)
-    else if (CurToken = tkIdentifier) or (CurToken=tklibrary) then // library is a token and a directive.
+    else if (CurToken=tklibrary) then // library is a token and a directive.
       begin
       Tok:=UpperCase(CurTokenString);
-      if DoCheckHint then
-        begin
-        consumesemi;
-        end
-      else if (tok = 'PUBLIC') then
-        begin
-        NextToken;
-        { Should be token Name,
-          if not we're in a class and the public section starts }
-        If (Uppercase(CurTokenString)<>'NAME') then
-          begin
-          UngetToken;
-          UngetToken;
-          Break;
-          end
-        else
-          begin
-          NextToken;  // Should be export name string.
-          ExpectToken(tkSemicolon);
-          end;
-        end
+      NextToken;
+      If (tok<>'NAME') then
+        Element.Hints:=Element.Hints+[hLibrary]
       else
         begin
-        UnGetToken;
-        Break;
-        end
+        NextToken;  // Should be export name string.
+        ExpectToken(tkSemicolon);
+        end;
       end
+    else if DoCheckHint then
+      consumesemi
     else if (CurToken = tkSquaredBraceOpen) then
       begin
       repeat
@@ -2742,11 +2749,12 @@ begin
     if Done then
       begin
       NextToken;
-      Done:=Not (IsCurtokenHint or IsModifier(CurtokenString,Pm) or TokenisCallingConvention(CurTokenString,cc));
+      Done:=Not ((Curtoken=tkSquaredBraceOpen) or TokenIsProcedureModifier(Parent,CurtokenString,Pm) or IscurtokenHint() or TokenisCallingConvention(CurTokenString,cc));
+//      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;
+//    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
   Until Done;
-// Writeln('End: ',TokenInfos[Curtoken],' ',CurtokenString);
   if DoCheckHint then  // deprecated,platform,experimental,library, unimplemented etc
     ConsumeSemi;
   if (ProcType = ptOperator) and (Parent is TPasProcedure) then
@@ -3484,7 +3492,7 @@ end;
 
 procedure TPasParser.DumpCurToken(Const Msg : String);
 begin
-  Writeln(Msg,' : ',TokenInfos[CurToken],' "',CurTokenString,'"');
+  Writeln(Msg,' : ',TokenInfos[CurToken],' "',CurTokenString,'"',Scanner.CurFilename,'(',Scanner.CurRow,',',SCanner.CurColumn,') : ',Scanner.CurLine);
   Flush(output)
 end;
 
@@ -3606,7 +3614,7 @@ begin
     AType.Members.Add(Proc);
 end;
 
-procedure TPasParser.ParseClassFields(AType: TPasClassType; Const AVisibility : TPasMemberVisibility);
+procedure TPasParser.ParseClassFields(AType: TPasClassType; Const AVisibility : TPasMemberVisibility; IsClassField : Boolean);
 
 Var
   VarList: TFPList;
@@ -3621,6 +3629,8 @@ begin
       begin
       Element := TPasElement(VarList[i]);
       Element.Visibility := AVisibility;
+      if IsClassField and (Element is TPasVariable) then
+        TPasVariable(Element).VarModifiers:=TPasVariable(Element).VarModifiers+[vmClass];
       AType.Members.Add(Element);
       end;
   finally
@@ -3628,6 +3638,25 @@ begin
   end;
 end;
 
+procedure TPasParser.ParseClassLocalTypes(AType: TPasClassType; AVisibility : TPasMemberVisibility);
+
+Var
+  T : TPasType;
+  Done : Boolean;
+begin
+//  Writeln('Parsing local types');
+  Repeat
+    T:=ParseTypeDecl(AType);
+    T.Visibility:=AVisibility;
+    AType.Members.Add(t);
+//    Writeln(CurtokenString,' ',TokenInfos[Curtoken]);
+    NextToken;
+    Done:=Curtoken<>tkIdentifier;
+    if Done then
+      UngetToken;
+  Until Done;
+end;
+
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
 
 Var
@@ -3638,13 +3667,18 @@ begin
   while (CurToken<>tkEnd) do
     begin
     case CurToken of
+      tkType:
+        begin
+        ExpectToken(tkIdentifier);
+        ParseClassLocalTypes(AType,CurVisibility);
+        end;
       tkVar,
       tkIdentifier:
         begin
         if CurToken=tkVar then
           ExpectToken(tkIdentifier);
         if Not CheckVisibility(CurtokenString,CurVisibility) then
-          ParseClassFields(AType,CurVisibility);
+          ParseClassFields(AType,CurVisibility,false);
         end;
       tkProcedure,tkFunction,tkConstructor,tkDestructor:
         ProcessMethod(AType,False,CurVisibility);
@@ -3656,7 +3690,7 @@ begin
          else if CurToken = tkVar then
            begin
            ExpectToken(tkIdentifier);
-           ParseClassFields(AType,CurVisibility);
+           ParseClassFields(AType,CurVisibility,true);
            end
          else if CurToken=tkProperty then
            begin

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -60,6 +60,7 @@ Type
     Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AValue : String) : TPrimitiveExpr;
     Procedure AssertExportSymbol(Const Msg: String; AIndex : Integer; AName,AExportName : String; AExportIndex : Integer = -1);
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasExprKind); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TexprOpcode); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberHint); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TCallingConvention); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TArgumentAccess); overload;
@@ -345,6 +346,13 @@ begin
                    GetEnumName(TypeInfo(TPasExprKind),Ord(AActual)));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TexprOpcode);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
+end;
+
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TPasMemberHint);
 begin

packages/fcl-passrc/tests/tcclasstype.pas

@@ -21,10 +21,11 @@ type
     FStarted: Boolean;
     function GetF1: TPasVariable;
     function GetM(AIndex : Integer): TPasElement;
-    function GetM1: TPasProcedure;
+    function GetMM(AIndex : Integer): TPasProcedure;
     function GetMF1: TPasFunction;
     function GetP1: TPasProperty;
     function GetP2: TPasProperty;
+    function GetT(AIndex : Integer) : TPasType;
   protected
     Procedure StartClass (AParent : String = 'TObject'; InterfaceList : String = '');
     Procedure StartVisibility(A : TPasMemberVisibility);
@@ -42,10 +43,14 @@ type
     Property Members[AIndex : Integer] : TPasElement Read GetM;
     Property Member1 : TPasElement Read FMember1;
     Property Field1 : TPasVariable Read GetF1;
-    Property Method1 : TPasProcedure Read GetM1;
+    Property Method1 : TPasProcedure Index 0 Read GetMM;
+    Property Method2 : TPasProcedure Index 1 Read GetMM;
+    Property Method3 : TPasProcedure index 2 Read GetMM;
     Property FunctionMethod1 : TPasFunction Read GetMF1;
     Property Property1 : TPasProperty Read GetP1;
     Property Property2 : TPasProperty Read GetP2;
+    Property Type1 : TPasType Index 0 Read GetT;
+    Property Type2 : TPasType Index 1 Read GetT;
   published
     procedure TestEmpty;
     procedure TestEmptyDeprecated;
@@ -54,10 +59,13 @@ type
     Procedure TestOneInterface;
     Procedure TestTwoInterfaces;
     Procedure TestOneField;
+    Procedure TestOneVarField;
+    Procedure TestOneClassField;
     Procedure TestOneFieldVisibility;
     Procedure TestOneFieldDeprecated;
     Procedure TestTwoFields;
     Procedure TestTwoFieldsB;
+    Procedure TestTwoVarFieldsB;
     Procedure TestTwoFieldsVisibility;
     procedure TestHintFieldDeprecated;
     procedure TestHintFieldPlatform;
@@ -100,6 +108,8 @@ type
     Procedure TestPropertyImplementsFullyQualifiedName;
     Procedure TestPropertyReadFromRecordField;
     procedure TestPropertyReadWriteFromRecordField;
+    Procedure TestLocalSimpleType;
+    Procedure TestLocalSimpleTypes;
   end;
 
 implementation
@@ -117,11 +127,11 @@ begin
   Result:=TPasElement(TheClass.Members[AIndex])
 end;
 
-function TTestClassType.GetM1: TPasProcedure;
+function TTestClassType.GetMM(AIndex : integer): TPasProcedure;
 begin
-  AssertNotNull('Have 1 member',Member1);
-  AssertEquals('Member 1 is method',TPasProcedure,Member1.ClassType);
-  Result:=TPasProcedure(Member1);
+  AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]);
+  AssertEquals('Member is method '+IntToStr(AIndex),TPasProcedure,Members[Aindex].ClassType);
+  Result:=TPasProcedure(Members[Aindex]);
 end;
 
 function TTestClassType.GetMF1: TPasFunction;
@@ -145,6 +155,14 @@ begin
   Result:=TPasProperty(Members[1]);
 end;
 
+function TTestClassType.GetT(Aindex :integer): TPasType;
+begin
+  AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]);
+  if not (Members[AIndex] is TPasType) then
+    Fail('Member '+IntToStr(AIndex)+' is not a type');
+  Result:=TPasType(Members[AIndex]);
+end;
+
 function TTestClassType.GetF1: TPasVariable;
 begin
   AssertNotNull('Have 1 member',Member1);
@@ -325,6 +343,30 @@ begin
   AssertVisibility;
 end;
 
+procedure TTestClassType.TestOneVarField;
+begin
+  StartVisibility(visPublished);
+  FDecl.Add('var');
+  AddMember('a : integer');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('a');
+  AssertVisibility(visPublished);
+end;
+
+procedure TTestClassType.TestOneClassField;
+begin
+  StartVisibility(visPublished);
+  FDecl.Add('class var');
+  AddMember('a : integer');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('a');
+  AssertVisibility(visPublished);
+  if not (vmClass in Field1.VarModifiers) then
+     Fail('Field is not a class field');
+end;
+
 procedure TTestClassType.TestOneFieldVisibility;
 begin
   StartVisibility(visPublished);
@@ -374,6 +416,22 @@ begin
   AssertVisibility(visDefault,Members[1]);
 end;
 
+procedure TTestClassType.TestTwoVarFieldsB;
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('var');
+  AddMember('a,b : integer');
+  ParseClass;
+  AssertEquals('2 members',2,TheClass.members.Count);
+  AssertNotNull('Have field',Field1);
+  AssertMemberName('a');
+  AssertVisibility(vispublic);
+  AssertNotNull('Have field',Members[1]);
+  AssertMemberName('b',Members[1]);
+  AssertMemberType(TPasVariable,Members[1]);
+  AssertVisibility(visPublic,Members[1]);
+end;
+
 procedure TTestClassType.TestTwoFieldsVisibility;
 begin
   StartVisibility(visPublic);
@@ -985,6 +1043,41 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
+procedure TTestClassType.TestLocalSimpleType;
+begin
+  StartVisibility(visPublic);
+  FDecl.add('Type');
+  AddMember('TDirection = (left,right)');
+  AddMember('Procedure Something');
+  ParseClass;
+  AssertEquals('Local Enumeration type',TPasEnumType, Type1.ClassType);
+  AssertEquals('Visibility is correct',VisPublic, Type1.Visibility);
+  AssertEquals('Type name','TDirection', Type1.Name);
+  AssertSame('Type parent is class',TheClass, Type1.Parent);
+  AssertNotNull('Member 2 is procedure',Method2);
+  AssertEquals('method name','Something', Method2.Name);
+end;
+
+procedure TTestClassType.TestLocalSimpleTypes;
+begin
+  StartVisibility(visPublic);
+  FDecl.add('Type');
+  AddMember('TDirection = (left,right)');
+  AddMember('TVerticalDirection = (up,down)');
+  AddMember('Procedure Something');
+  ParseClass;
+  AssertEquals('Local Enumeration type',TPasEnumType, Type1.ClassType);
+  AssertEquals('Visibility is correct',VisPublic, Type1.Visibility);
+  AssertEquals('Type name','TDirection', Type1.Name);
+  AssertSame('Type parent is class',TheClass, Type1.Parent);
+  AssertEquals('Local Enumeration type',TPasEnumType, Type2.ClassType);
+  AssertEquals('Visibility is correct',VisPublic, Type2.Visibility);
+  AssertEquals('Type name','TVerticalDirection', Type2.Name);
+  AssertSame('Type parent is class',TheClass, Type2.Parent);
+  AssertNotNull('Member 2 is procedure',Method3);
+  AssertEquals('method name','Something', Method3.Name);
+end;
+
 initialization
 
   RegisterTest(TTestClassType);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -0,0 +1,901 @@
+unit tcexprparser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, tcbaseparser, pastree;
+
+type
+
+  { TTestExpressions }
+
+  TTestExpressions= class(TTestParser)
+  private
+    FLeft: TPAsExpr;
+    FRight: TPAsExpr;
+    FTheExpr: TPasExpr;
+    FVariables : TStringList;
+    procedure AssertLeftPrecedence(AInnerLeft: Integer; AInnerOp: TExprOpCode;
+      AInnerRight: Integer; AOuterOp: TexprOpCode; AOuterRight: Integer);
+    procedure AssertRightPrecedence(AOuterLeft: Integer; AOuterOp: TExprOpCode;
+      AInnerLeft: Integer; AInnerOp: TexprOpCode; AInnerRight: Integer);
+    procedure DeclareVar(const AVarType: String; const AVarName: String = 'a');
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure SetExpression(Const AExpression : String);
+    Procedure ParseExpression;
+    Procedure ParseExpression(Const AExpression : String);
+    Function AssertBinaryExpr(Const Msg : String; Op : TExprOpCode; Out ALeft,ARight : TPasExpr) : TBinaryExpr;
+    Function AssertBinaryExpr(Const Msg : String; AExpr : TPasExpr; Op : TExprOpCode; Out ALeft,ARight : TPasExpr) : TBinaryExpr;
+    Function AssertUnaryExpr(Const Msg : String; Op : TExprOpCode; Out AOperand : TPasExpr) : TUnaryExpr;
+    Function AssertUnaryExpr(Const Msg : String; AExpr: TPasExpr; Op : TExprOpCode; Out AOperand : TPasExpr) : TUnaryExpr;
+    Property TheExpr : TPasExpr read FTheExpr;
+    Property Theleft : TPAsExpr Read FLeft;
+    Property TheRight : TPAsExpr Read FRight;
+  published
+    {
+      TPasExprKind = (pekRange,
+       pekListOfExp, );
+    }
+    procedure TestPrimitiveInteger;
+    procedure TestPrimitiveIntegerHex;
+    procedure TestPrimitiveIntegerOctal;
+    procedure TestPrimitiveIntegerBinary;
+    procedure TestPrimitiveDouble;
+    procedure TestPrimitiveString;
+    procedure TestPrimitiveIdent;
+    procedure TestPrimitiveBooleanFalse;
+    procedure TestPrimitiveBooleanTrue;
+    procedure TestPrimitiveNil;
+    procedure TestPrimitiveSet;
+    procedure TestPrimitiveChar;
+    procedure TestPrimitiveControlChar;
+    procedure TestPrimitiveSetEmpty;
+    procedure TestPrimitiveSelf;
+    Procedure TestInherited;
+    Procedure TestInheritedFunction;
+    Procedure TestUnaryMinus;
+    Procedure TestUnaryMinusWhiteSpace;
+    Procedure TestUnaryAddress;
+    Procedure TestUnaryNot;
+    Procedure TestUnaryDeref;
+    Procedure TestBinaryAdd;
+    Procedure TestBinarySubtract;
+    Procedure TestBinaryMultiply;
+    Procedure TestBinaryDivision;
+    Procedure TestBinaryPower;
+    Procedure TestBinaryMod;
+    Procedure TestBinaryDiv;
+    procedure TestBinaryShl;
+    procedure TestBinaryShr;
+    Procedure TestBinarySymmetricalDifference;
+    Procedure TestBinaryAnd;
+    Procedure TestBinaryOr;
+    Procedure TestBinaryXOr;
+    Procedure TestBinaryIn;
+    Procedure TestBinaryIs;
+    Procedure TestBinaryAs;
+    Procedure TestBinaryEquals;
+    Procedure TestBinaryDiffers;
+    Procedure TestBinaryLessThan;
+    Procedure TestBinaryLessThanEqual;
+    Procedure TestBinaryLargerThan;
+    Procedure TestBinaryLargerThanEqual;
+    procedure TestBinaryFullIdent;
+    Procedure TestArrayElement;
+    Procedure TestArrayElement2Dims;
+    Procedure TestFunctionCall;
+    Procedure TestFunctionCall2args;
+    Procedure TestFunctionCallNoArgs;
+    Procedure TestRange;
+    Procedure TestBracketsTotal;
+    Procedure TestBracketsLeft;
+    Procedure TestBracketsRight;
+    Procedure TestPrecedenceLeftToRight;
+    Procedure TestPrecedenceLeftToRightMinus;
+    Procedure TestPrecedenceLeftToRightMultiply;
+    Procedure TestPrecedenceLeftToRightDivision;
+    Procedure TestPrecedenceLeftToRightPlusMinus;
+    Procedure TestPrecedenceLeftToRightMinusPlus;
+    Procedure TestPrecedenceLeftToRightMultiplyDivision;
+    Procedure TestPrecedenceLeftToRightDivisionMultiply;
+    Procedure TestPrecedencePlusMultiply;
+    Procedure TestPrecedencePlusDivide;
+    Procedure TestPrecedenceMinusMultiply;
+    Procedure TestPrecedenceMinusDivide;
+    Procedure TestPrecedencePlusOr;
+    Procedure TestPrecedenceAndOr;
+    Procedure TestPrecedenceAndNot;
+    Procedure TestPrecedencePlusAnd;
+    Procedure TestPrecedenceMinusOr;
+    Procedure TestPrecedenceMinusAnd;
+    Procedure TestPrecedenceMultiplyOr;
+    Procedure TestPrecedenceMultiplyAnd;
+    Procedure TestPrecedencePlusDiv;
+    Procedure TestPrecedencePlusMod;
+    Procedure TestPrecedenceMultiplyDiv;
+    Procedure TestPrecedenceDivMultiply;
+  end;
+
+implementation
+
+procedure TTestExpressions.DeclareVar(const AVarType: String;
+const AVarName: String = 'a');
+begin
+  FVariables.Add(AVarName+' : '+AVarType+';');
+end;
+
+procedure TTestExpressions.TestPrimitiveInteger;
+begin
+  ParseExpression('1');
+  AssertExpression('Simple integer',theExpr,pekNumber,'1');
+end;
+
+procedure TTestExpressions.TestPrimitiveIntegerHex;
+begin
+  ParseExpression('$FF');
+  AssertExpression('Simple integer',theExpr,pekNumber,'$FF');
+end;
+
+procedure TTestExpressions.TestPrimitiveIntegerOctal;
+begin
+  ParseExpression('&777');
+  AssertExpression('Simple integer',theExpr,pekNumber,'&777');
+end;
+
+procedure TTestExpressions.TestPrimitiveIntegerBinary;
+begin
+  ParseExpression('%10101010');
+  AssertExpression('Simple integer',theExpr,pekNumber,'%10101010');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble;
+begin
+  ParseExpression('1.2');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.2');
+end;
+
+procedure TTestExpressions.TestPrimitiveString;
+begin
+  DeclareVar('string');
+  ParseExpression('''123''');
+  AssertExpression('Simple string',theExpr,pekString,'''123''');
+end;
+
+procedure TTestExpressions.TestPrimitiveIdent;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('integer','b');
+  ParseExpression('b');
+  AssertExpression('Simple identifier',theExpr,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestBinaryFullIdent;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('record x,y : integer; end','b');
+  ParseExpression('b.x');
+  AssertBinaryExpr('sub identifier',eopSubIdent,Fleft,FRight);
+  AssertExpression('Simple identifier',Theleft,pekIdent,'b');
+  AssertExpression('Simple identifier',Theright,pekIdent,'x');
+end;
+
+procedure TTestExpressions.TestArrayElement;
+
+Var
+  P : TParamsExpr;
+
+begin
+  DeclareVar('integer','a');
+  DeclareVar('array[1..2] of integer','b');
+  ParseExpression('b[1]');
+  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
+  AssertExpression('Name of array',P.Value,pekIdent,'b');
+  AssertEquals('One dimension',1,Length(p.params));
+  AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+end;
+
+procedure TTestExpressions.TestArrayElement2Dims;
+Var
+  P : TParamsExpr;
+
+begin
+  DeclareVar('integer','a');
+  DeclareVar('array[1..2,1..2] of integer','b');
+  ParseExpression('b[1,2]');
+  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
+  AssertExpression('Name of array',P.Value,pekIdent,'b');
+  AssertEquals('Two dimensions',2,Length(p.params));
+  AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+  AssertExpression('Simple identifier',p.params[1],pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestFunctionCall;
+Var
+  P : TParamsExpr;
+
+begin
+  DeclareVar('integer','a');
+  ParseExpression('Random(10)');
+  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
+  AssertExpression('Name of function',P.Value,pekIdent,'Random');
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('Simple identifier',p.params[0],pekNumber,'10');
+end;
+
+procedure TTestExpressions.TestFunctionCall2args;
+Var
+  P : TParamsExpr;
+
+begin
+  DeclareVar('integer','a');
+  ParseExpression('Random(10,12)');
+  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
+  AssertExpression('Name of function',P.Value,pekIdent,'Random');
+  AssertEquals('2 argument',2,Length(p.params));
+  AssertExpression('Simple identifier 1',p.params[0],pekNumber,'10');
+  AssertExpression('Simple identifier 2',p.params[1],pekNumber,'12');
+end;
+
+procedure TTestExpressions.TestFunctionCallNoArgs;
+
+Var
+  P : TParamsExpr;
+
+begin
+  DeclareVar('integer','a');
+  ParseExpression('Random()');
+  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekFuncParams,TParamsExpr));
+  AssertExpression('Name of function',P.Value,pekIdent,'Random');
+  AssertEquals('0 arguments',0,Length(p.params));
+end;
+
+procedure TTestExpressions.TestRange;
+
+Var
+  B : TBinaryExpr;
+
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('byte','b');
+  ParseExpression('b in 0..10');
+  AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekIdent,'b');
+  B:=TBinaryExpr(AssertExpression('Right is range',TheRight,pekRange,TBinaryExpr));
+  AssertExpression('Left is 0',B.Left,pekNumber,'0');
+  AssertExpression('Right is 10',B.Right,pekNumber,'10');
+end;
+
+procedure TTestExpressions.TestBracketsTotal;
+begin
+  DeclareVar('integer','a');
+  ParseExpression('(3+4)');
+  AssertBinaryExpr('simple binary add',eopAdd,FLeft,FRight);
+  AssertExpression('Inner Left is 3',TheLeft,pekNumber,'3');
+  AssertExpression('Inner Right is 4',TheRight,pekNumber,'4');
+end;
+
+procedure TTestExpressions.TestBracketsLeft;
+begin
+  DeclareVar('integer','a');
+  ParseExpression('2*(3+4)');
+  AssertRightPrecedence(2,eopMultiply,3,eopAdd,4);
+end;
+
+procedure TTestExpressions.TestBracketsRight;
+begin
+  DeclareVar('integer','a');
+  ParseExpression('(2*3)+4');
+  AssertLeftPrecedence(2,eopMultiply,3,eopAdd,4);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRight;
+begin
+  ParseExpression('1+2+3');
+  AssertLeftPrecedence(1,eopAdd,2,eopAdd,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightMinus;
+begin
+  ParseExpression('1-2-3');
+  AssertLeftPrecedence(1,eopSubtract,2,eopSubtract,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightMultiply;
+begin
+  ParseExpression('1*2*3');
+  AssertLeftPrecedence(1,eopMultiply,2,eopMultiply,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightDivision;
+begin
+  ParseExpression('1/2/3');
+  AssertLeftPrecedence(1,eopDivide,2,eopDivide,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightPlusMinus;
+begin
+  ParseExpression('1+2-3');
+  AssertLeftPrecedence(1,eopAdd,2,eopSubtract,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightMinusPlus;
+begin
+  ParseExpression('1-2+3');
+  AssertLeftPrecedence(1,eopSubtract,2,eopAdd,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightMultiplyDivision;
+begin
+  ParseExpression('1*2/3');
+  AssertLeftPrecedence(1,eopMultiply,2,eopDivide,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceLeftToRightDivisionMultiply;
+begin
+  ParseExpression('1/2*3');
+  AssertLeftPrecedence(1,eopDivide,2,eopMultiply,3);
+end;
+
+procedure TTestExpressions.TestPrecedencePlusMultiply;
+begin
+  ParseExpression('1+2*3');
+  AssertRightPrecedence(1,eopAdd,2,eopMultiply,3);
+end;
+
+procedure TTestExpressions.TestPrecedencePlusDivide;
+begin
+  ParseExpression('1+2/3');
+  AssertRightPrecedence(1,eopAdd,2,eopDivide,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMinusMultiply;
+begin
+  ParseExpression('1-2*3');
+  AssertRightPrecedence(1,eopsubtract,2,eopMultiply,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMinusDivide;
+begin
+  ParseExpression('1-2/3');
+  AssertRightPrecedence(1,eopsubtract,2,eopDivide,3);
+end;
+
+procedure TTestExpressions.TestPrecedencePlusOr;
+begin
+  ParseExpression('1 or 2 + 3');
+  AssertLeftPrecedence(1,eopor,2,eopAdd,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceAndOr;
+begin
+  ParseExpression('1 or 2 and 3');
+  AssertRightPrecedence(1,eopor,2,eopAnd,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceAndNot;
+begin
+  ParseExpression('Not 1 and 3');
+  AssertBinaryExpr('Simple binary and',eopAnd,FLeft,FRight);
+  AssertExpression('Outer right is 3',TheRight,pekNumber,'3');
+  AssertUnaryExpr('Left is Unary not ',TheLeft,eopNot,FRight);
+  AssertExpression('Inner Right is 1',TheRight,pekNumber,'1');
+end;
+
+procedure TTestExpressions.TestPrecedencePlusAnd;
+begin
+  ParseExpression('1 + 2 and 3');
+  AssertRightPrecedence(1,eopAdd,2,eopAnd,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMinusOr;
+begin
+  ParseExpression('1 or 2 - 3');
+  AssertLeftPrecedence(1,eopOr,2,eopSubtract,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMinusAnd;
+begin
+  ParseExpression('1 - 2 and 3');
+  AssertRightPrecedence(1,eopSubtract,2,eopand,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMultiplyOr;
+begin
+  ParseExpression('1 or 2 * 3');
+  AssertRightPrecedence(1,eopOr,2,eopMultiply,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceMultiplyAnd;
+begin
+  ParseExpression('1 * 2 and 3');
+  AssertLeftPrecedence(1,eopMultiply,2,eopAnd,3);
+end;
+
+procedure TTestExpressions.TestPrecedencePlusDiv;
+begin
+  ParseExpression('1+2 div 3');
+  AssertRightPrecedence(1,eopAdd,2,eopDiv,3);
+end;
+
+procedure TTestExpressions.TestPrecedencePlusMod;
+begin
+  ParseExpression('1+2 mod 3');
+  AssertRightPrecedence(1,eopAdd,2,eopMod,3);
+end;
+
+procedure TTestExpressions.AssertLeftPrecedence(AInnerLeft : Integer; AInnerOp : TExprOpCode; AInnerRight : Integer; AOuterOp : TexprOpCode; AOuterRight: Integer);
+
+begin
+  AssertBinaryExpr('Outer expression',AOuterOp,FLeft,FRight);
+  AssertExpression('Outer right constant',TheRight,pekNumber,intToStr(AOuterRight));
+  AssertBinaryExpr('Inner (left) expression',TheLeft,AInnerOp,FLeft,FRight);
+  AssertExpression('Inner Left constant',TheLeft,pekNumber,IntToStr(AInnerLeft));
+  AssertExpression('Inner Right constant',TheRight,pekNumber,IntToStr(AInnerRight));
+end;
+
+
+procedure TTestExpressions.AssertRightPrecedence(AOuterLeft : Integer; AOuterOp : TExprOpCode; AInnerLeft : Integer; AInnerOp : TexprOpCode; AInnerRight: Integer);
+
+begin
+  AssertBinaryExpr('Outer expression',AOuterOp,FLeft,FRight);
+  AssertExpression('Outer left constant',TheLeft,pekNumber,intToStr(AOuterLeft));
+  AssertBinaryExpr('Inner (right) expression',TheRight,AInnerOp,FLeft,FRight);
+  AssertExpression('Inner Left constant',TheLeft,pekNumber,IntToStr(AInnerLeft));
+  AssertExpression('Inner Right constant',TheRight,pekNumber,IntToStr(AInnerRight));
+end;
+
+procedure TTestExpressions.TestPrecedenceMultiplyDiv;
+begin
+  ParseExpression('1 * 2 div 3');
+  AssertLeftPrecedence(1,eopMultiply,2,eopDiv,3);
+end;
+
+procedure TTestExpressions.TestPrecedenceDivMultiply;
+begin
+  ParseExpression('1 div 2 * 3');
+  AssertLeftPrecedence(1,eopDiv,2,eopMultiply,3);
+end;
+
+
+procedure TTestExpressions.TestUnaryMinus;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('integer','b');
+  ParseExpression('-b');
+  AssertUnaryExpr('Simple minus unary',eopSubtract,FLeft);
+  AssertExpression('Simple identifier',theLeft,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryMinusWhiteSpace;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('integer','b');
+  ParseExpression('- b');
+  AssertUnaryExpr('Simple minus unary',eopSubtract,FLeft);
+  AssertExpression('Simple identifier',theLeft,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryAddress;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('integer','b');
+  ParseExpression('@b');
+  AssertUnaryExpr('Simple address unary',eopAddress,FLeft);
+  AssertExpression('Simple identifier',theLeft,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryNot;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('boolean','b');
+  ParseExpression('not b');
+  AssertUnaryExpr('Simple address unary',eopNot,FLeft);
+  AssertExpression('Simple identifier',theLeft,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryDeref;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('pinteger','b');
+  ParseExpression('b^');
+  AssertUnaryExpr('Simple address unary',eopDeref,FLeft);
+  AssertExpression('Simple identifier',theLeft,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestBinaryAdd;
+begin
+  ParseExpression('1+2');
+  AssertBinaryExpr('Simple binary add',eopAdd,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinarySubtract;
+begin
+  ParseExpression('1-2');
+  AssertBinaryExpr('Simple binary subtract',eopSubtract,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryMultiply;
+begin
+  ParseExpression('1*2');
+  AssertBinaryExpr('Simple binary multiply',eopMultiply,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryDivision;
+begin
+  DeclareVar('double');
+  ParseExpression('1/2');
+  AssertBinaryExpr('Simple binary division',eopDivide,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryPower;
+begin
+  DeclareVar('double');
+  ParseExpression('1**2');
+  AssertBinaryExpr('Simple binary power',eopPower,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryMod;
+begin
+  ParseExpression('1 mod 2');
+  AssertBinaryExpr('Simple binary mod',eopMod,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryDiv;
+begin
+  ParseExpression('1 div 2');
+  AssertBinaryExpr('Simple binary div',eopDiv,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryShl;
+begin
+  ParseExpression('1 shl 2');
+  AssertBinaryExpr('Simple binary shl',eopShl,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinaryShr;
+begin
+  ParseExpression('1 shr 2');
+  AssertBinaryExpr('Simple binary shr',eopShr,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is 2',TheRight,pekNumber,'2');
+end;
+
+procedure TTestExpressions.TestBinarySymmetricalDifference;
+begin
+  DeclareVar('Set of Byte','a');
+  DeclareVar('Set of Byte','b');
+  DeclareVar('Set of Byte','c');
+  ParseExpression('b >< c');
+  AssertBinaryExpr('Simple binary smmetrical difference',eopSymmetricalDifference,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryAnd;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('boolean','b');
+  DeclareVar('boolean','b');
+  ParseExpression('b and c');
+  AssertBinaryExpr('Simple binary and',eopAnd,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekIdent,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryOr;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('boolean','b');
+  DeclareVar('boolean','b');
+  ParseExpression('b or c');
+  AssertBinaryExpr('Simple binary or',eopOr,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekIdent,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryXOr;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('boolean','b');
+  DeclareVar('boolean','b');
+  ParseExpression('b xor c');
+  AssertBinaryExpr('Simple binary xor',eopxOr,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekIdent,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryIn;
+begin
+  DeclareVar('boolean','a');
+  ParseExpression('1 in [1,2,3]');
+  AssertBinaryExpr('Simple binary In',eopIn,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekNumber,'1');
+  AssertExpression('Right is array set',TheRight,pekSet,TParamsExpr);
+end;
+
+procedure TTestExpressions.TestBinaryIs;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('TObject','b');
+  ParseExpression('b is TObject');
+  AssertBinaryExpr('Simple binary Is',eopIs,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekident,'b');
+  AssertExpression('Right is TObject',TheRight,pekIdent,'TObject');
+end;
+
+procedure TTestExpressions.TestBinaryAs;
+begin
+  DeclareVar('TObject','a');
+  DeclareVar('TObject','b');
+  ParseExpression('b as TObject');
+  AssertBinaryExpr('Simple binary As',eopAs,FLeft,FRight);
+  AssertExpression('Left is 1',TheLeft,pekident,'b');
+  AssertExpression('Right is TObject',TheRight,pekIdent,'TObject');
+end;
+
+procedure TTestExpressions.TestBinaryEquals;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b=c');
+  AssertBinaryExpr('Simple binary equals',eopEqual,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryDiffers;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b<>c');
+  AssertBinaryExpr('Simple binary differs',eopNotEqual,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryLessThan;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b<c');
+  AssertBinaryExpr('Simple binary less than',eopLessThan,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryLessThanEqual;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b<=c');
+  AssertBinaryExpr('Simple binary less than or equal',eopLessThanEqual,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryLargerThan;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b>c');
+  AssertBinaryExpr('Simple binary larger than ',eopGreaterThan,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestBinaryLargerThanEqual;
+begin
+  DeclareVar('boolean','a');
+  DeclareVar('integer','b');
+  DeclareVar('integer','c');
+  ParseExpression('b>=c');
+  AssertBinaryExpr('Simple binary larger than or equal',eopGreaterThanEqual,FLeft,FRight);
+  AssertExpression('Left is b',TheLeft,pekident,'b');
+  AssertExpression('Right is c',TheRight,pekIdent,'c');
+end;
+
+procedure TTestExpressions.TestPrimitiveBooleanFalse;
+begin
+  DeclareVar('boolean','a');
+  ParseExpression('False');
+  AssertExpression('Simple boolean',theExpr,pekBoolConst,TBoolConstExpr);
+  AssertEquals('Boolean false',False,TBoolConstExpr(TheExpr).Value);
+end;
+
+procedure TTestExpressions.TestPrimitiveBooleanTrue;
+begin
+  DeclareVar('boolean','a');
+  ParseExpression('True');
+  AssertExpression('Simple boolean',theExpr,pekBoolConst,TBoolConstExpr);
+  AssertEquals('Boolean true',True,TBoolConstExpr(TheExpr).Value);
+end;
+
+procedure TTestExpressions.TestPrimitiveNil;
+begin
+  DeclareVar('pointer','a');
+  ParseExpression('Nil');
+  AssertExpression('Nil expr',theExpr,pekNil,TNilExpr);
+end;
+
+procedure TTestExpressions.TestPrimitiveSet;
+
+Var
+  P : TParamsExpr;
+begin
+  DeclareVar('set of byte','a');
+  ParseExpression('[1,2,3]');
+  P:=TParamsExpr(AssertExpression('Set expr',theExpr,pekSet,TParamsExpr));
+  AssertEquals('Element count',3,Length(P.Params));
+  AssertExpression('Element 1 in set',P.Params[0],pekNumber,'1');
+  AssertExpression('Element 2 in set',P.Params[1],pekNumber,'2');
+  AssertExpression('Element 3 in set',P.Params[2],pekNumber,'3');
+end;
+
+procedure TTestExpressions.TestPrimitiveChar;
+begin
+  DeclareVar('char');
+  ParseExpression('#32');
+  AssertExpression('Simple string',theExpr,pekString,'#32');
+end;
+
+procedure TTestExpressions.TestPrimitiveControlChar;
+begin
+  DeclareVar('char');
+  ParseExpression('^M');
+  AssertExpression('Simple string',theExpr,pekString,'^M');
+end;
+
+procedure TTestExpressions.TestPrimitiveSetEmpty;
+
+Var
+  P : TParamsExpr;
+begin
+  DeclareVar('set of byte','a');
+  ParseExpression('[]');
+  P:=TParamsExpr(AssertExpression('Set expr',theExpr,pekSet,TParamsExpr));
+  AssertEquals('Element count',0,Length(P.Params));
+end;
+
+procedure TTestExpressions.TestPrimitiveSelf;
+Var
+  S : TSelfExpr;
+begin
+  DeclareVar('pointer','a');
+  ParseExpression('Self');
+  S:=TSelfExpr(AssertExpression('Inherited expr',theExpr,pekSelf,TSelfExpr));
+end;
+
+procedure TTestExpressions.TestInherited;
+
+Var
+  I: TInheritedExpr;
+begin
+  DeclareVar('pointer','a');
+  ParseExpression('inherited');
+  I:=TInheritedExpr(AssertExpression('Inherited expr',theExpr,pekInherited,TInheritedExpr));
+end;
+
+procedure TTestExpressions.TestInheritedFunction;
+
+Var
+  I: TInheritedExpr;
+begin
+  DeclareVar('pointer','a');
+  ParseExpression('inherited myfunction');
+  AssertBinaryExpr('Inherited expr',eopNone,Fleft,FRight);
+  AssertExpression('Inherited expr',theleft,pekInherited,TInheritedExpr);
+  AssertExpression('Inherited expr',theright,pekIdent,'myfunction');
+end;
+
+procedure TTestExpressions.SetUp;
+begin
+  Inherited;
+  FVariables:=TStringList.Create;
+end;
+
+procedure TTestExpressions.TearDown;
+
+begin
+  FreeAndNil(FVariables);
+  Inherited;
+end;
+
+procedure TTestExpressions.SetExpression(const AExpression: String);
+
+Var
+  I : Integer;
+
+begin
+  StartProgram('afile');
+  if FVariables.Count=0 then
+    DeclareVar('integer');
+  Add('Var');
+  For I:=0 to FVariables.Count-1 do
+    Add('  '+Fvariables[I]);
+  Add('begin');
+  Add('  a:='+AExpression+';');
+end;
+
+procedure TTestExpressions.ParseExpression;
+begin
+  ParseModule;
+  AssertEquals('Have program',TPasProgram,Module.ClassType);
+  AssertNotNull('Have program section',PasProgram.ProgramSection);
+  AssertNotNull('Have initialization section',PasProgram.InitializationSection);
+  AssertEquals('Have initialization statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertNotNull('Have initialization statement',PasProgram.InitializationSection.Elements[0]);
+  AssertEquals('Assignment statement',TPasImplAssign,TObject(PasProgram.InitializationSection.Elements[0]).ClassType);
+  FTheExpr:=TPasImplAssign(PasProgram.InitializationSection.Elements[0]).right;
+  AssertNotNull('Have assignment expression',FTheExpr);
+end;
+
+procedure TTestExpressions.ParseExpression(const AExpression: String);
+begin
+  SetExpression(AExpression);
+  ParseExpression;
+end;
+
+function TTestExpressions.AssertBinaryExpr(const Msg: String; Op: TExprOpCode;
+  out ALeft, ARight: TPasExpr): TBinaryExpr;
+begin
+  Result:=AssertBinaryExpr(Msg,TheExpr,Op,ALeft,ARight);
+end;
+
+function TTestExpressions.AssertBinaryExpr(const Msg: String; AExpr: TPasExpr;
+  Op: TExprOpCode; out ALeft, ARight: TPasExpr): TBinaryExpr;
+begin
+  AssertExpression(Msg+' is binary',AExpr,pekBinary,TBinaryExpr);
+  Result:=AExpr as TBinaryExpr;
+  AssertEquals(Msg+' opcode OK',Op,Result.OpCode);
+  ALeft:=Result.Left;
+  ARight:=Result.Right;
+  AssertNotNull('Have left',ALeft);
+  AssertNotNull('Have right',ARight);
+end;
+
+function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;
+  out AOperand : TPasExpr): TUnaryExpr;
+begin
+  Result:=AssertUnaryExpr(Msg,TheExpr,OP,AOperand);
+end;
+
+function TTestExpressions.AssertUnaryExpr(const Msg: String; AExpr: TPasExpr;
+  Op: TExprOpCode; out AOperand: TPasExpr): TUnaryExpr;
+begin
+  AssertExpression(Msg+' is unary',AExpr,pekUnary,TUnaryExpr);
+  Result:=AExpr as TUnaryExpr;
+  AssertEquals(Msg+' opcode OK',Op,Result.OpCode);
+  AOperand:=Result.Operand;
+  AssertNotNull('Have left',AOperand);
+end;
+
+initialization
+
+  RegisterTest(TTestExpressions);
+end.
+

packages/fcl-passrc/tests/tcscanner.pas

@@ -663,7 +663,7 @@ end;
 
 procedure TTestScanner.TestAssignDivision;
 begin
-  TestTokens([tkDivision,tkEqual],'*=');
+  TestTokens([tkDivision,tkEqual],'/=');
   FScanner.Options:=[po_cassignments];
   TestToken(tkAssignDivision,'/=');
 end;

packages/fcl-passrc/tests/tcstatements.pas

@@ -144,7 +144,7 @@ begin
   ParseModule;
   AssertEquals('Have program',TPasProgram,Module.ClassType);
   AssertNotNull('Have program section',PasProgram.ProgramSection);
-  AssertNotNull('Have program section',PasProgram.InitializationSection);
+  AssertNotNull('Have initialization section',PasProgram.InitializationSection);
   if (PasProgram.InitializationSection.Elements.Count>0) then
     if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
       FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);

packages/fcl-passrc/tests/testpassrc.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="9">
+    <Units Count="10">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -83,6 +83,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcclasstype"/>
       </Unit8>
+      <Unit9>
+        <Filename Value="tcexprparser.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcexprparser"/>
+      </Unit9>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-passrc/tests/testpassrc.lpr

@@ -5,7 +5,7 @@ program testpassrc;
 uses
   Classes, consoletestrunner, tcscanner, 
 tctypeparser, tcstatements, tcbaseparser,
-  tcmoduleparser, tconstparser, tcvarparser, tcclasstype;
+  tcmoduleparser, tconstparser, tcvarparser, tcclasstype, tcexprparser;
 
 type