* For in construct and class/record helpers implemented

git-svn-id: trunk@22170 -

packages/fcl-passrc/src/pastree.pp

@@ -50,6 +50,8 @@ resourcestring
   SPasTreeInterfaceType = 'interface';
   SPasTreeGenericType = 'generic class';
   SPasTreeSpecializedType = 'specialized class type';
+  SPasClassHelperType = 'Class helper type';
+  SPasRecordHelperType = 'Record helper type';
   SPasTreeArgument = 'argument';
   SPasTreeProcedureType = 'procedure type';
   SPasTreeResultElement = 'function result';
@@ -499,7 +501,8 @@ type
   end;
 
   TPasGenericTemplateType = Class(TPasElement);
-  TPasObjKind = (okObject, okClass, okInterface, okGeneric, okSpecialize);
+  TPasObjKind = (okObject, okClass, okInterface, okGeneric, okSpecialize,
+                 okClassHelper,okRecordHelper);
 
   { TPasClassType }
 
@@ -512,16 +515,17 @@ type
     PackMode : TPackMode;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
+    HelperForType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsForward : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
+    GUIDExpr : TPasExpr;
     Members: TFPList;     // array of TPasElement objects
-    InterfaceGUID : string; // 15/06/07 - Inoussa
-
     ClassVars: TFPList;   // class vars
     Modifiers: TStringList;
     Interfaces : TFPList;
     GenericTemplateTypes : TFPList;
     Function IsPacked : Boolean;
+    Function InterfaceGUID : string;
   end;
 
 
@@ -705,7 +709,6 @@ type
     FModifiers : TProcedureModifiers;
     FMessageName : String;
     FMessageType : TProcedureMessageType;
-    FPublicName: String;
     function GetCallingConvention: TCallingConvention;
     procedure SetCallingConvention(AValue: TCallingConvention);
   public
@@ -1014,7 +1017,7 @@ type
   end;
 
   { TPasImplForLoop }
-
+  TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
   public
     destructor Destroy; override;
@@ -1024,8 +1027,9 @@ type
     StartExpr : TPasExpr;
     EndExpr : TPasExpr;
     VariableName : String;
-    Down: boolean; // downto
+    LoopType : TLoopType;
     Body: TPasImplElement;
+    Function Down: boolean; // downto, backward compatibility
     Function StartValue : String;
     Function EndValue: string;
   end;
@@ -1128,7 +1132,7 @@ const
     'default', 'private', 'protected', 'public', 'published', 'automated','strict private', 'strict protected');
 
   ObjKindNames: array[TPasObjKind] of string = (
-    'object', 'class', 'interface','class','class');
+    'object', 'class', 'interface','class','class','class helper','record helper');
   
   OpcodeStrings : Array[TExprOpCode] of string = 
        ('','+','-','*','/','div','mod','**',
@@ -1354,9 +1358,19 @@ begin
     okInterface: Result := SPasTreeInterfaceType;
     okGeneric : Result := SPasTreeGenericType;
     okSpecialize : Result := SPasTreeSpecializedType;
+    okClassHelper : Result:=SPasClassHelperType;
+    okRecordHelper : Result:=SPasRecordHelperType;
   end;
 end;
 
+function TPasClassType.InterfaceGUID: string;
+begin
+  If Assigned(GUIDExpr) then
+    Result:=GUIDExpr.GetDeclaration(True)
+  else
+    Result:=''
+end;
+
 function TPasClassType.IsPacked: Boolean;
 begin
   Result:=PackMode<>pmNone;
@@ -1687,6 +1701,9 @@ begin
   Members.Free;
   if Assigned(AncestorType) then
     AncestorType.Release;
+  if Assigned(HelperForType) then
+    HelperForType.Release;
+  FreeAndNil(GUIDExpr);
   Modifiers.Free;
   ClassVars.Free;
   Interfaces.Free;
@@ -1964,6 +1981,11 @@ begin
     raise Exception.Create('TPasImplForLoop.AddElement body already set - please report this bug');
 end;
 
+function TPasImplForLoop.Down: boolean;
+begin
+  Result:=(LoopType=ltDown);
+end;
+
 function TPasImplForLoop.StartValue: String;
 begin
   If Assigned(StartExpr) then
@@ -2071,7 +2093,8 @@ begin
   Result.VariableName := AVarName;
   Result.StartExpr := AStartValue;
   Result.EndExpr := AEndValue;
-  Result.Down := ADownTo;
+  if ADownto then
+    Result.Looptype := ltDown;
   AddElement(Result);
 end;
 

packages/fcl-passrc/src/pparser.pp

@@ -36,6 +36,7 @@ resourcestring
   SParserExpectToken2Error = 'Expected "%s" or "%s"';
   SParserExpectedCommaRBracket = 'Expected "," or ")"';
   SParserExpectedCommaSemicolon = 'Expected "," or ";"';
+  SParserExpectedAssignIn = 'Expected := or in';
   SParserExpectedCommaColon = 'Expected "," or ":"';
   SParserOnlyOneArgumentCanHaveDefault = 'A default value can only be assigned to 1 parameter';
   SParserExpectedLBracketColon = 'Expected "(" or ":"';
@@ -55,10 +56,12 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
-
+  SParserHelperNotAllowed = 'Helper objects not allowed for "%s"';
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SParsingUsedUnit = 'Parsing used unit "%s" with commandLine "%s"';
+  SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
+  SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
 
 type
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
@@ -181,6 +184,7 @@ type
     function CurTokenText: String;
     procedure NextToken; // read next non whitespace, non space
     procedure UngetToken;
+    procedure CheckToken(tk: TToken);
     procedure ExpectToken(tk: TToken);
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
@@ -610,12 +614,17 @@ begin
   end;
 end;
 
+procedure TPasParser.CheckToken(tk: TToken);
+begin
+  if (CurToken<>tk) then
+    ParseExc(Format(SParserExpectTokenError, [TokenInfos[tk]]));
+end;
+
 
 procedure TPasParser.ExpectToken(tk: TToken);
 begin
   NextToken;
-  if CurToken <> tk then
-    ParseExc(Format(SParserExpectTokenError, [TokenInfos[tk]]));
+  CheckToken(tk);
 end;
 
 function TPasParser.ExpectIdentifier: String;
@@ -913,7 +922,7 @@ Const
   // These types are allowed only when full type declarations
   FullTypeTokens = [tkGeneric,tkSpecialize,tkClass,tkInterface,tkType];
   // Parsing of these types already takes care of hints
-  NoHintTokens = [tkClass,tkObject,tkInterface,tkProcedure,tkFunction];
+  NoHintTokens = [tkProcedure,tkFunction];
 var
   PM : TPackMode;
   CH : Boolean; // Check hint ?
@@ -945,11 +954,25 @@ begin
       tkSet: Result:=ParseSetType(Parent,TypeName);
       tkProcedure: Result:=ParseProcedureType(Parent,TypeName,ptProcedure);
       tkFunction: Result:=ParseProcedureType(Parent,TypeName,ptFunction);
-      tkRecord: Result := ParseRecordDecl(Parent,TypeName,PM);
+      tkRecord:
+        begin
+        NextToken;
+        if (Curtoken=tkHelper) then
+          begin
+          UnGetToken;
+          Result:=ParseClassDecl(Parent,TypeName,okRecordHelper,PM);
+          end
+        else
+          begin
+          UnGetToken;
+          Result := ParseRecordDecl(Parent,TypeName,PM);
+          end;
+        end;
     else
       UngetToken;
       Result:=ParseRangeType(Parent,TypeName,Full);
     end;
+    DumpCurToken('Done');
     if CH then
       CheckHint(Result,True);
   Except
@@ -2009,7 +2032,8 @@ begin
           NextToken;
           DoParseClassType(ClassEl);
           Declarations.Declarations.Add(ClassEl);
-          Declarations.Classes.Add(ClassEl)
+          Declarations.Classes.Add(ClassEl);
+          CheckHint(classel,True);
         end;
       tkbegin:
         begin
@@ -3017,11 +3041,12 @@ var
   VarName: String;
   SubBlock: TPasImplElement;
   CmdElem: TPasImplElement;
-  ForDownTo: Boolean;
   left: TPasExpr;
   right: TPasExpr;
   el : TPasImplElement;
   ak : TAssignKind;
+  lt : TLoopType;
+
 begin
   NewImplElement:=nil;
   CurBlock := Parent;
@@ -3109,31 +3134,44 @@ begin
     tkfor:
       begin
         // for VarName := StartValue to EndValue do
+        // for VarName in Expression do
         ExpectIdentifier;
         VarName:=CurTokenString;
-        ExpectToken(tkAssign);
-        NextToken;
-        Left:=DoParseExpression(Parent);
-        UnGetToken;
-        //writeln(i,'FOR Start=',StartValue);
         NextToken;
-        if CurToken=tkTo then
-          ForDownTo:=false
-        else if CurToken=tkdownto then
-          ForDownTo:=true
+        Left:=Nil;
+        Right:=Nil;
+        if Not (CurToken in [tkAssign,tkIn]) then
+          ParseExc(SParserExpectedAssignIn);
+        if (CurToken=tkAssign) then
+          lt:=ltNormal
         else
-          ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
+          lt:=ltin;
         NextToken;
-        Right:=DoParseExpression(Parent);
-        UngetToken;
+        Left:=DoParseExpression(Parent);
+        Try
+          if (Lt=ltNormal) then
+            begin
+            if Not (CurToken in [tkTo,tkDownTo]) then
+              ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
+            if CurToken=tkdownto then
+              Lt:=ltDown;
+            NextToken;
+            Right:=DoParseExpression(Parent);
+            end;
+          if (CurToken<>tkDo) then
+            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkDo]]));
+        except
+          FreeAndNil(Left);
+          FreeAndNil(Right);
+          Raise;
+        end;
         el:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
         TPasImplForLoop(el).VariableName:=VarName;
         TPasImplForLoop(el).StartExpr:=Left;
         TPasImplForLoop(el).EndExpr:=Right;
-        TPasImplForLoop(el).Down:=forDownto;
+        TPasImplForLoop(el).LoopType:=lt;
         CreateBlock(TPasImplForLoop(el));
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
-        ExpectToken(tkdo);
       end;
     tkwith:
       begin
@@ -3559,15 +3597,15 @@ end;
 Function TPasParser.ParseRecordDecl(Parent: TPasElement; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType;
 
 begin
-  Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent));
-  try
-    Result.PackMode:=PackMode;
-    NextToken;
-    ParseRecordFieldList(Result,tkEnd);
-  except
-    FreeAndNil(Result);
-    Raise;
-  end;
+    Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent));
+    try
+      Result.PackMode:=PackMode;
+      NextToken;
+      ParseRecordFieldList(Result,tkEnd);
+    except
+      FreeAndNil(Result);
+      Raise;
+    end;
 end;
 
 Function IsVisibility(S : String;  Out AVisibility :TPasMemberVisibility) : Boolean;
@@ -3719,13 +3757,19 @@ begin
       tkVar,
       tkIdentifier:
         begin
+        if (AType.ObjKind=okInterface) then
+          ParseExc(SParserNoFieldsAllowed);
         if CurToken=tkVar then
           ExpectToken(tkIdentifier);
         if Not CheckVisibility(CurtokenString,CurVisibility) then
           ParseClassFields(AType,CurVisibility,false);
         end;
       tkProcedure,tkFunction,tkConstructor,tkDestructor:
+        begin
+        if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okRecordHelper]) then
+          ParseExc(SParserNoConstructorAllowed);
         ProcessMethod(AType,False,CurVisibility);
+        end;
       tkclass:
         begin
          NextToken;
@@ -3789,17 +3833,26 @@ begin
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
-  if not (AType.IsShortDefinition or AType.IsForward) then
+  if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
+    begin
+    if (CurToken<>tkFor) then
+      ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkFor]]));
+    AType.HelperForType:=ParseType(Nil);
+    NextToken;
+    end;
+  if (AType.IsShortDefinition or AType.IsForward) then
+    UngetToken
+  else
     begin
     if (AType.ObjKind=okInterface) and (CurToken = tkSquaredBraceOpen) then
       begin
-      ExpectToken(tkString);
-      AType.InterfaceGUID := CurTokenString;
-      ExpectToken(tkSquaredBraceClose);
+      NextToken;
+      AType.GUIDExpr:=DoParseExpression(AType);
+      if (CurToken<>tkSquaredBraceClose) then
+        ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkSquaredBraceClose]]));
+      NextToken;
       end;
     ParseClassMembers(AType);
-    // Eat semicolon after class...end
-    CheckHint(AType,true);
     end;
 end;
 
@@ -3817,16 +3870,22 @@ begin
   NextToken;
 
   if (AObjKind = okClass) and (CurToken = tkOf) then
-  begin
+    begin
     Result := TPasClassOfType(Engine.CreateElement(TPasClassOfType, AClassName,
       Parent, SourceFilename, SourceLinenumber));
     ExpectIdentifier;
     UngetToken;                // Only names are allowed as following type
     TPasClassOfType(Result).DestType := ParseType(Result);
-    CheckHint(Result,true);
     exit;
-  end;
-
+    end;
+  if (CurToken = tkHelper) then
+    begin
+    if Not (AObjKind in [okClass,okRecordHelper]) then
+      ParseExc(Format(SParserHelperNotAllowed,[ObjKindNames[AObjKind]]));
+    if (AObjKind = okClass)  then
+      AObjKind:=okClassHelper;
+    NextToken;
+    end;
   Result := TPasClassType(Engine.CreateElement(TPasClassType, AClassName,
     Parent, SourceFilename, SourceLinenumber));
 

packages/fcl-passrc/src/pscanner.pp

@@ -109,6 +109,7 @@ type
     tkfunction,
     tkgeneric,
     tkgoto,
+    tkHelper,
     tkif,
     tkimplementation,
     tkin,
@@ -439,6 +440,7 @@ const
     'function',
     'generic',
     'goto',
+    'helper',
     'if',
     'implementation',
     'in',

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -61,6 +61,8 @@ 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: TLoopType); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasObjKind); 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;
@@ -363,6 +365,20 @@ begin
                    GetEnumName(TypeInfo(TPasExprKind),Ord(AActual)));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TLoopType);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TLoopType),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TLoopType),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TPasObjKind);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
+end;
+
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TexprOpcode);
 begin

packages/fcl-passrc/tests/tcclasstype.pas

@@ -29,6 +29,9 @@ type
     function GetT(AIndex : Integer) : TPasType;
   protected
     Procedure StartClass (AParent : String = 'TObject'; InterfaceList : String = '');
+    Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
+    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = '');
+    Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartVisibility(A : TPasMemberVisibility);
     Procedure EndClass(AEnd : String = 'end');
     Procedure AddMember(S : String);
@@ -36,6 +39,7 @@ type
     procedure SetUp; override;
     procedure TearDown; override;
     procedure DefaultMethod;
+    Procedure AssertParserError(Const Msg : String);
     Procedure AssertVisibility(V : TPasMemberVisibility = visDefault; Member : TPasElement = Nil);
     procedure AssertMemberType(AType : TClass; Member : TPaselement = Nil);
     procedure AssertMemberName(AName : string; Member : TPaselement = Nil);
@@ -119,6 +123,21 @@ type
     Procedure TestLocalSimpleTypes;
     Procedure TestLocalSimpleConst;
     Procedure TestLocalSimpleConsts;
+    procedure TestClassHelperEmpty;
+    procedure TestClassHelperParentedEmpty;
+    procedure TestClassHelperOneMethod;
+    procedure TestInterfaceEmpty;
+    procedure TestInterfaceParentedEmpty;
+    procedure TestInterfaceOneMethod;
+    procedure TestInterfaceNoConstructor;
+    procedure TestInterfaceNoDestructor;
+    procedure TestInterfaceNoFields;
+    procedure TestInterfaceUUID;
+    procedure TestInterfaceUUIDParentedEmpty;
+    procedure TestInterfaceUUIDOneMethod;
+    procedure TestRecordHelperEmpty;
+    procedure TestRecordHelperParentedEmpty;
+    procedure TestRecordHelperOneMethod;
   end;
 
 implementation
@@ -205,6 +224,52 @@ begin
   FParent:=AParent;
 end;
 
+procedure TTestClassType.StartClassHelper(ForType: String; AParent: String);
+Var
+  S : String;
+begin
+  FStarted:=True;
+  S:='TMyClass = Class Helper';
+  if (AParent<>'') then
+    begin
+    S:=S+'('+AParent;
+    S:=S+')';
+    end;
+  S:=S+' for '+ForType;
+  FDecl.Add(S);
+  FParent:=AParent;
+end;
+
+procedure TTestClassType.StartInterface(AParent: String; UUID: String);
+Var
+  S : String;
+begin
+  FStarted:=True;
+  S:='TMyClass = Interface';
+  if (AParent<>'') then
+    S:=S+' ('+AParent+')';
+  if (UUID<>'') then
+    S:=S+' ['''+UUID+''']';
+  FDecl.Add(S);
+  FParent:=AParent;
+end;
+
+procedure TTestClassType.StartRecordHelper(ForType: String; AParent: String);
+Var
+  S : String;
+begin
+  FStarted:=True;
+  S:='TMyClass = Record Helper';
+  if (AParent<>'') then
+    begin
+    S:=S+'('+AParent;
+    S:=S+')';
+    end;
+  S:=S+' for '+ForType;
+  FDecl.Add(S);
+  FParent:=AParent;
+end;
+
 procedure TTestClassType.StartVisibility(A: TPasMemberVisibility);
 begin
   if not FStarted then
@@ -242,8 +307,12 @@ begin
      begin
      AssertNotNull('Have parent class',TheClass.AncestorType);
      AssertEquals('Parent class',TPasUnresolvedTypeRef,TheClass.AncestorType.ClassType);
-     AssertEquals('Parent class name','TObject',TPasUnresolvedTypeRef(TheClass.AncestorType).Name);
+     AssertEquals('Parent class name',FParent,TPasUnresolvedTypeRef(TheClass.AncestorType).Name);
      end;
+  if (TheClass.ObjKind<>okInterface) then
+    AssertNull('No interface, No GUID',TheClass.GUIDExpr);
+  if (Not (TheClass.ObjKind in [okClassHelper,okRecordHelper])) then
+    AssertNull('No helperfortype if not helper',TheClass.HelperForType);
   if TheClass.Members.Count>0 then
     FMember1:=TObject(TheClass.Members[0]) as TPaselement;
 end;
@@ -574,6 +643,11 @@ begin
   AssertEquals('Argument name','A',TPasVariable(Method1.ProcType.Args[0]).Name);
 end;
 
+procedure TTestClassType.AssertParserError(Const Msg : String);
+begin
+  AssertException(Msg,EParserError,@ParseClass)
+end;
+
 procedure TTestClassType.TestMethodOneArg;
 begin
   AddMember('Procedure DoSomething(A : Integer)');
@@ -1186,6 +1260,171 @@ begin
   AssertEquals('method name','Something', Method3.Name);
 end;
 
+procedure TTestClassType.TestClassHelperEmpty;
+begin
+  StartClassHelper('TOriginal','');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is class helper',okClassHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.CLassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  AssertEquals('No members',0,TheClass.Members.Count);
+end;
+
+procedure TTestClassType.TestClassHelperParentedEmpty;
+begin
+  StartClassHelper('TOriginal','TOtherHelper');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is class helper',okClassHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.CLassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  AssertEquals('No members',0,TheClass.Members.Count);
+end;
+
+procedure TTestClassType.TestClassHelperOneMethod;
+begin
+  StartClassHelper('TOriginal','');
+  AddMember('Procedure DoSomething(A : Integer)');
+  ParseClass;
+  AssertEquals('Is class helper',okClassHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.CLassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
+procedure TTestClassType.TestInterfaceEmpty;
+begin
+  StartInterface('','');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
+procedure TTestClassType.TestInterfaceParentedEmpty;
+begin
+  StartInterface('IInterface','');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
+procedure TTestClassType.TestInterfaceOneMethod;
+begin
+  StartInterface('IInterface','');
+  AddMember('Procedure DoSomething(A : Integer)');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
+procedure TTestClassType.TestInterfaceNoConstructor;
+begin
+  StartInterface('','');
+  AddMember('Constructor DoSomething(A : Integer)');
+  AssertParserError('No constructor in interface');
+end;
+
+procedure TTestClassType.TestInterfaceNoDestructor;
+begin
+  StartInterface('','');
+  AddMember('Destructor DoSomething(A : Integer)');
+  AssertParserError('No destructor in interface');
+end;
+
+procedure TTestClassType.TestInterfaceNoFields;
+begin
+  StartInterface('','');
+  AddMember('AField : Integer');
+  AssertParserError('No fields in interface');
+end;
+
+procedure TTestClassType.TestInterfaceUUID;
+begin
+  StartInterface('','123');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertExpression('UUID',TheClass.GUIDExpr,pekString,'''123''');
+end;
+
+procedure TTestClassType.TestInterfaceUUIDParentedEmpty;
+begin
+  StartInterface('IInterface','123');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertExpression('UUID',TheClass.GUIDExpr,pekString,'''123''');
+end;
+
+procedure TTestClassType.TestInterfaceUUIDOneMethod;
+begin
+  StartInterface('IInterface','123');
+  AddMember('Procedure DoSomething(A : Integer)');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+  AssertExpression('UUID',TheClass.GUIDExpr,pekString,'''123''');
+end;
+
+procedure TTestClassType.TestRecordHelperEmpty;
+begin
+  StartRecordHelper('TOriginal','');
+  ParseClass;
+  AssertEquals('Is Record helper',okRecordHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.ClassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  AssertEquals('No members',0,TheClass.Members.Count);
+end;
+
+procedure TTestClassType.TestRecordHelperParentedEmpty;
+begin
+  StartRecordHelper('TOriginal','TOtherHelper');
+  ParseClass;
+  AssertEquals('Is Record helper',okRecordHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.ClassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  AssertEquals('No members',0,TheClass.Members.Count);
+end;
+
+procedure TTestClassType.TestRecordHelperOneMethod;
+begin
+  StartRecordHelper('TOriginal','');
+  AddMember('Procedure DoSomething(A : Integer)');
+  ParseClass;
+  AssertEquals('Is Record helper',okRecordHelper,TheClass.ObjKind);
+  AssertNotNull('Have helper original',TheClass.HelperForType);
+  AssertEquals('Have helper original alias',TPasUnresolvedTypeRef,TheClass.HelperForType.ClassType);
+  AssertEquals('Helper original alias name','TOriginal',TheClass.HelperForType.Name);
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
 initialization
 
   RegisterTest(TTestClassType);

packages/fcl-passrc/tests/tcexprparser.pas

@@ -5,7 +5,7 @@ unit tcexprparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, tcbaseparser, pastree;
+  Classes, SysUtils, fpcunit,  testregistry, tcbaseparser, pastree;
 
 type
 
@@ -782,28 +782,23 @@ begin
 end;
 
 procedure TTestExpressions.TestPrimitiveSelf;
-Var
-  S : TSelfExpr;
+
 begin
   DeclareVar('pointer','a');
   ParseExpression('Self');
-  S:=TSelfExpr(AssertExpression('Inherited expr',theExpr,pekSelf,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));
+  AssertExpression('Inherited expr',theExpr,pekInherited,TInheritedExpr);
 end;
 
 procedure TTestExpressions.TestInheritedFunction;
 
-Var
-  I: TInheritedExpr;
 begin
   DeclareVar('pointer','a');
   ParseExpression('inherited myfunction');

packages/fcl-passrc/tests/tcscanner.pas

@@ -135,6 +135,7 @@ type
     procedure TestFunction;
     procedure TestGeneric;
     procedure TestGoto;
+    Procedure TestHelper;
     procedure TestIf;
     procedure TestImplementation;
     procedure TestIn;
@@ -892,6 +893,11 @@ begin
   TestToken(tkgoto,'goto');
 end;
 
+procedure TTestScanner.TestHelper;
+begin
+  TestToken(tkHelper,'helper');
+end;
+
 
 procedure TTestScanner.TestIf;
 

packages/fcl-passrc/tests/tcstatements.pas

@@ -57,6 +57,7 @@ Type
     procedure TestRepeatBlockNosemicolon;
     Procedure TestRepeatNested;
     Procedure TestFor;
+    Procedure TestForIn;
     Procedure TestForExpr;
     Procedure TestForBlock;
     procedure TestDowntoBlock;
@@ -607,12 +608,30 @@ begin
   TestStatement(['For a:=1 to 10 do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
   AssertEquals('Loop variable name','a',F.VariableName);
+  AssertEquals('Loop type',ltNormal,F.Looptype);
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
   AssertExpression('End value',F.EndExpr,pekNumber,'10');
   AssertNull('Empty body',F.Body);
 end;
 
+procedure TTestStatementParser.TestForIn;
+
+Var
+  F : TPasImplForLoop;
+
+begin
+  DeclareVar('integer');
+  TestStatement(['For a in SomeSet Do',';']);
+  F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
+  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertEquals('Loop type',ltIn,F.Looptype);
+  AssertEquals('In loop',False,F.Down);
+  AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
+  AssertNull('Loop type',F.EndExpr);
+  AssertNull('Empty body',F.Body);
+end;
+
 procedure TTestStatementParser.TestForExpr;
 Var
   F : TPasImplForLoop;