fcl-passrc: parse and resolve helpers

git-svn-id: trunk@41022 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -119,7 +119,7 @@ const
   nWrongNumberOfParametersForArray = 3042;
   nCantAssignValuesToAnAddress = 3043;
   nIllegalExpression = 3044;
-  nCantAccessPrivateMember = 3045;
+  nCantAccessXMember = 3045;
   nMustBeInsideALoop = 3046;
   nExpectXArrayElementsButFoundY = 3047;
   nCannotCreateADescendantOfTheSealedXY = 3048;
@@ -178,6 +178,8 @@ const
   nFunctionHidesIdentifier_NonProc = 3112;
   nTypeXCannotBeExtendedByATypeHelper = 3113;
   nDerivedXMustExtendASubClassY = 3114;
+  nDefaultPropertyNotAllowedInHelperForX = 3115;
+  nHelpersCannotBeUsedAsTypes = 3116;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -236,7 +238,7 @@ resourcestring
   sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
   sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
   sIllegalExpression = 'Illegal expression';
-  sCantAccessPrivateMember = 'Can''t access %s member %s';
+  sCantAccessXMember = 'Can''t access %s member %s';
   sMustBeInsideALoop = '%s must be inside a loop';
   sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
   sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
@@ -303,6 +305,8 @@ resourcestring
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
   sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
+  sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
+  sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pastree.pp

@@ -741,6 +741,12 @@ type
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
+const
+  okWithFields = [okObject, okClass, okGeneric];
+  okAllHelpers = [okClassHelper,okRecordHelper,okTypeHelper];
+  okWithClassFields = okWithFields+okAllHelpers;
+
+type
 
   TPasClassInterfaceType = (
     citCom, // default
@@ -1074,11 +1080,25 @@ type
   end;
 
   { TPasOperator }
-  TOperatorType = (otUnknown,otImplicit,otExplicit,otMul,otPlus, otMinus, otDivision,otLessThan, otEqual,
-                   otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
-                   otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
-                   otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
-                   otRightShift,otEnumerator, otIn);
+  TOperatorType = (
+    otUnknown,
+    otImplicit, otExplicit,
+    otMul, otPlus, otMinus, otDivision,
+    otLessThan, otEqual, otGreaterThan,
+    otAssign, otNotEqual, otLessEqualThan, otGreaterEqualThan,
+    otPower, otSymmetricalDifference,
+    otInc, otDec,
+    otMod,
+    otNegative, otPositive,
+    otBitWiseOr,
+    otDiv,
+    otLeftShift,
+    otLogicalOr,
+    otBitwiseAnd, otbitwiseXor,
+    otLogicalAnd, otLogicalNot, otLogicalXor,
+    otRightShift,
+    otEnumerator, otIn
+    );
   TOperatorTypes = set of TOperatorType;
 
   TPasOperator = class(TPasFunction)

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1452,7 +1452,7 @@ begin
       begin
       if Ref.WithExprScope<>nil then
         begin
-        if Ref.WithExprScope.Scope is TPasRecordScope then
+        if Ref.WithExprScope.ClassRecScope is TPasRecordScope then
           begin
           // a record member was accessed -> access the record too
           UseExprRef(El,Ref.WithExprScope.Expr,Access,false);

packages/fcl-passrc/src/pparser.pp

@@ -135,7 +135,7 @@ resourcestring
   // free for 2029
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
-  SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
+  SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records';
   SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
   SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
@@ -731,11 +731,7 @@ begin
       end;
     Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
     if (poSkipDefaultDefs in Options) then
-      begin
-      Writeln('>>> Clearing <<<');
       Parser.ImplicitUses.Clear;
-      end;
-    Writeln('Implicit >>>',Parser.ImplicitUses.Text,'<<<');
     Filename := '';
     Parser.LogEvents:=AEngine.ParserLogEvents;
     Parser.OnLog:=AEngine.Onlog;
@@ -3353,13 +3349,27 @@ end;
 
 procedure TPasParser.ParseDeclarations(Declarations: TPasDeclarations);
 var
+  HadTypeSection: boolean;
   CurBlock: TDeclType;
 
   procedure SetBlock(NewBlock: TDeclType);
   begin
     if CurBlock=NewBlock then exit;
     if CurBlock=declType then
-      Engine.FinishScope(stTypeSection,Declarations);
+      begin
+      if msDelphi in CurrentModeswitches then
+        // Delphi allows forward types only inside a type section
+        Engine.FinishScope(stTypeSection,Declarations);
+      end;
+    if NewBlock=declType then
+      HadTypeSection:=true
+    else if (NewBlock=declNone) and HadTypeSection then
+      begin
+      HadTypeSection:=false;
+      if not (msDelphi in CurrentModeswitches) then
+        // ObjFPC allows forward types inside a whole section
+        Engine.FinishScope(stTypeSection,Declarations);
+      end;
     CurBlock:=NewBlock;
     Scanner.SetForceCaret(NewBlock=declType);
   end;
@@ -3383,6 +3393,7 @@ var
   RecordEl: TPasRecordType;
 begin
   CurBlock := declNone;
+  HadTypeSection:=false;
   while True do
   begin
     if CurBlock in [DeclNone,declConst,declType] then
@@ -3655,7 +3666,7 @@ begin
         break;
         end
       else if (Declarations is TInterfaceSection)
-      or (Declarations is TImplementationSection) then
+          or (Declarations is TImplementationSection) then
         begin
         SetBlock(declNone);
         ParseInitialization;
@@ -4014,7 +4025,7 @@ begin
       end;
     if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
       ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkColon], TokenInfos[tkGreaterThan]]);
+        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
   until CurToken = tkGreaterThan;
 end;
 
@@ -6227,7 +6238,7 @@ begin
   ptOperator,ptClassOperator:
     begin
     NextToken;
-    IsTokenBased:=Curtoken<>tkIdentifier;
+    IsTokenBased:=CurToken<>tkIdentifier;
     if IsTokenBased then
       OT:=TPasOperator.TokenToOperatorType(CurTokenText)
     else
@@ -6690,8 +6701,8 @@ Type
 Var
   CurVisibility : TPasMemberVisibility;
   CurSection : TSectionType;
-  haveClass ,
-    IsMethodResolution: Boolean; // true means last token was class keyword
+  haveClass: boolean; // true means last token was class keyword
+  IsMethodResolution: Boolean;
   LastToken: TToken;
   PropEl: TPasProperty;
   MethodRes: TPasMethodResolution;
@@ -6734,8 +6745,8 @@ begin
       tkVar:
         if not (CurSection in [stVar,stClassVar]) then
           begin
-          if (AType.ObjKind in [okClass,okObject,okGeneric])
-          or (haveClass and (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper])) then
+          if (AType.ObjKind in okWithFields)
+          or (haveClass and (AType.ObjKind in okAllHelpers)) then
             // ok
           else
             ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
@@ -6759,14 +6770,14 @@ begin
           stNone,
           stVar:
             begin
-            if not (AType.ObjKind in [okObject,okClass,okGeneric]) then
+            if not (AType.ObjKind in okWithFields) then
               ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
             ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
             HaveClass:=False;
             end;
           stClassVar:
             begin
-            if not (AType.ObjKind in [okObject,okClass,okGeneric,okClassHelper,okRecordHelper,okTypeHelper]) then
+            if not (AType.ObjKind in okWithClassFields) then
               ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
             ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
             HaveClass:=False;
@@ -6780,12 +6791,19 @@ begin
         curSection:=stNone;
         if not haveClass then
           SaveComments;
-        if (AType.ObjKind in [okObject,okClass,okGeneric])
-            or ((CurToken=tkconstructor)
-              and (AType.ObjKind in [okClassHelper,okTypeHelper,okRecordHelper])) then
-          // ok
+        case AType.ObjKind of
+        okObject,okClass,okGeneric: ;
+        okClassHelper,okTypeHelper,okRecordHelper:
+          begin
+          if (CurToken=tkdestructor) and not haveClass then
+            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+          end;
         else
-          ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
+          if CurToken=tkconstructor then
+            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['constructor',ObjKindNames[AType.ObjKind]])
+          else
+            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+        end;
         ProcessMethod(AType,HaveClass,CurVisibility);
         haveClass:=False;
         end;
@@ -6891,7 +6909,7 @@ begin
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
-  if (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper]) then
+  if (AType.ObjKind in okAllHelpers) then
     begin
     CheckToken(tkfor);
     NextToken;
@@ -6963,7 +6981,7 @@ begin
     AExternalNameSpace:='';
     AExternalName:='';
     end;
-  if AObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
+  if AObjKind in okAllHelpers then
     begin
     if not CurTokenIsIdentifier('Helper') then
       ParseExcSyntaxError;

packages/fcl-passrc/src/pscanner.pp

@@ -294,8 +294,9 @@ type
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
     msIgnoreAttributes,    { workaround til resolver/converter supports attributes }
-    msOmitRTTI             { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
-  );
+    msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
+    msMultipleScopeHelpers { off=only one helper per type, on=all }
+    );
   TModeSwitches = Set of TModeSwitch;
 
   // switches, that can be 'on' or 'off'
@@ -987,7 +988,7 @@ const
     'Tab'
   );
 
-  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[18]{$endif} =
+  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[20]{$endif} =
   ( '', // msNone
     '', // Fpc,
     '', // Objfpc,
@@ -1037,7 +1038,8 @@ const
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
     'IGNOREATTRIBUTES',
-    'OMITRTTI'
+    'OMITRTTI',
+    'MULTIPLESCOPEHELPERS'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(

packages/fcl-passrc/tests/tcgenerics.pp

@@ -12,20 +12,21 @@ Type
   { TTestGenerics }
 
   TTestGenerics = Class(TBaseTestTypeParser)
-  private
   Published
     Procedure TestObjectGenerics;
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
+    Procedure TestGenericConstraint;
+    Procedure TestDeclarationConstraint;
     Procedure TestSpecializationDelphi;
-    procedure TestDeclarationConstraint;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
-    procedure TestDeclarationFPC;
+    Procedure TestDeclarationFPC;
     Procedure TestMethodImplementation;
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestInlineSpecializeInStatement;
+    Procedure TestGenericFunction; // ToDo
   end;
 
 implementation
@@ -61,20 +62,25 @@ begin
   ParseDeclarations;
 end;
 
-procedure TTestGenerics.TestSpecializationDelphi;
+procedure TTestGenerics.TestGenericConstraint;
 begin
-  ParseType('TFPGList<integer>',TPasSpecializeType,'');
+  Add([
+    'Type',
+    'Generic TSomeClass<T: TObject> = class',
+    '  b : T;',
+    'end;',
+    '']);
+  ParseDeclarations;
 end;
 
-procedure TTestGenerics.TestDeclarationDelphi;
+procedure TTestGenerics.TestDeclarationConstraint;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T: T2> = Class(TObject)');
   Source.Add('  b : T;');
-  Source.Add('  b2 : T2;');
   Source.Add('end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
@@ -82,18 +88,23 @@ begin
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+  AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
 end;
 
-procedure TTestGenerics.TestDeclarationFPC;
+procedure TTestGenerics.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasSpecializeType,'');
+end;
+
+procedure TTestGenerics.TestDeclarationDelphi;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
   Source.Add('  b : T;');
   Source.Add('  b2 : T2;');
   Source.Add('end;');
@@ -108,34 +119,35 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
-
-procedure TTestGenerics.TestDeclarationConstraint;
+procedure TTestGenerics.TestDeclarationDelphiSpecialize;
 Var
   T : TPasClassType;
 begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T: T2> = Class(TObject)');
+  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
   Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
   Source.Add('end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
+  AssertEquals('Name is correct','TSomeClass',T.Name);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
-procedure TTestGenerics.TestDeclarationDelphiSpecialize;
+procedure TTestGenerics.TestDeclarationFPC;
 Var
   T : TPasClassType;
 begin
-  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
   Source.Add('Type');
-  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
+  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
   Source.Add('  b : T;');
   Source.Add('  b2 : T2;');
   Source.Add('end;');
@@ -144,7 +156,6 @@ begin
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
-  AssertEquals('Name is correct','TSomeClass',T.Name);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
   AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
@@ -206,6 +217,19 @@ begin
   ParseModule;
 end;
 
+procedure TTestGenerics.TestGenericFunction;
+begin
+  exit; // ToDo
+  Add([
+  'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  IfThen<word>(true,2,3);',
+  '']);
+  ParseModule;
+end;
+
 initialization
   RegisterTest(TTestGenerics);
 end.

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -1273,18 +1273,20 @@ procedure TTestProcedureFunction.TestOperatorNames;
 
 Var
   t : TOperatorType;
+  S: String;
 
 begin
   For t:=Succ(otUnknown) to High(TOperatorType) do
       begin
+      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
       ResetParser;
       if t in UnaryOperators then
         AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
       else
         AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
       ParseOperator;
-      AssertEquals('Token based',False,FOperator.TokenBased);
-      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
+      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
       if t in UnaryOperators then
         AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
       else

packages/fcl-passrc/tests/tcresolver.pas

@@ -490,6 +490,7 @@ type
     Procedure TestAdvRecord;
     Procedure TestAdvRecord_Private;
     Procedure TestAdvRecord_StrictPrivate;
+    Procedure TestAdvRecord_StrictPrivateFail;
     Procedure TestAdvRecord_MethodImplMissingFail;
     Procedure TestAdvRecord_VarConst;
     Procedure TestAdvRecord_RecVal_ConstFail;
@@ -520,6 +521,9 @@ type
     Procedure TestClassForwardAsAncestorFail;
     Procedure TestClassForwardNotResolved;
     Procedure TestClassForwardDuplicateFail;
+    Procedure TestClassForwardDelphiFail;
+    Procedure TestClassForwardObjFPCProgram;
+    Procedure TestClassForwardObjFPCUnit;
     Procedure TestClass_Method;
     Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_MethodImplDuplicateFail;
@@ -658,6 +662,8 @@ type
     Procedure TestPropertyReadAccessorFuncWrongResult;
     Procedure TestPropertyReadAccessorFuncWrongArgCount;
     Procedure TestPropertyReadAccessorFunc;
+    Procedure TestPropertyReadAccessorStrictPrivate;
+    Procedure TestPropertyReadAccessorNonClassFail;
     Procedure TestPropertyWriteAccessorVarWrongType;
     Procedure TestPropertyWriteAccessorFuncNotProc;
     Procedure TestPropertyWriteAccessorProcWrongArgCount;
@@ -863,12 +869,35 @@ type
     // helpers
     Procedure ClassHelper;
     Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
+    Procedure ClassHelper_HelperForParentFail;
     Procedure ClassHelper_ForInterfaceFail;
     Procedure ClassHelper_FieldFail;
     Procedure ClassHelper_AbstractFail;
     Procedure ClassHelper_VirtualObjFPCFail;
+    Procedure ClassHelper_VirtualDelphiFail;
+    Procedure ClassHelper_DestructorFail;
+    Procedure ClassHelper_ClassRefersToTypeHelperOfAncestor;
+    Procedure ClassHelper_InheritedObjFPC;
+    Procedure ClassHelper_InheritedObjFPC2;
+    Procedure ClassHelper_InheritedObjFPCStrictPrivateFail;
+    Procedure ClassHelper_InheritedDelphi;
+    Procedure ClassHelper_NestedInheritedParentFail;
+    Procedure ClassHelper_AccessFields;
+    Procedure ClassHelper_CallClassMethodFail;
+    Procedure ClassHelper_AsTypeFail;
+    Procedure ClassHelper_Enumerator;
+    Procedure ClassHelper_FromUnitInterface;
+    // ToDo ClassHelper_Constructor
+    // ToDo ClassHelper_DefaultProperty
+    // ToDo ClassHelper_MultiScopeHelpers
     Procedure RecordHelper;
+    // RecordHelper_Constructor
     Procedure TypeHelper;
+    Procedure TypeHelper_HelperForProcTypeFail;
+    Procedure TypeHelper_DefaultPropertyFail;
+    Procedure TypeHelper_Enum;
+    Procedure TypeHelper_Enumerator;
+    // TypeHelper_Constructor
 
     // attributes
     Procedure TestAttributes_Ignore;
@@ -7872,6 +7901,30 @@ begin
 end;
 
 procedure TTestResolver.TestAdvRecord_StrictPrivate;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '  strict private',
+  '    FSize: longword;',
+  '    function GetSize: longword;',
+  '  public',
+  '    property Size: longword read GetSize write FSize;',
+  '  end;',
+  'function TRec.GetSize: longword;',
+  'begin',
+  '  FSize:=GetSize;',
+  'end;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  '  r.Size:=r.Size;']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAdvRecord_StrictPrivateFail;
 begin
   StartProgram(false);
   Add([
@@ -7885,7 +7938,7 @@ begin
   '  r: TRec;',
   'begin',
   '  r.a:=r.a;']);
-  CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
+  CheckResolverException('Can''t access strict private member A',nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestAdvRecord_MethodImplMissingFail;
@@ -8616,6 +8669,62 @@ begin
   CheckResolverException('Duplicate identifier "TObject" at afile.pp(3,10)',nDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestClassForwardDelphiFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class;',
+  'const k = 1;',
+  'type',
+  '  TBird = class',
+  '  end;',
+  'begin']);
+  CheckResolverException('Forward type not resolved "TBird"',nForwardTypeNotResolved);
+end;
+
+procedure TTestResolver.TestClassForwardObjFPCProgram;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class;',
+  'const k = 1;',
+  'type',
+  '  TBird = class',
+  '  end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassForwardObjFPCUnit;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode objfpc}',
+  'interface',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class;',
+  'const k = 1;',
+  'type',
+  '  TBird = class',
+  '  end;',
+  'implementation',
+  'type',
+  '  TEagle = class;',
+  'const c = 1;',
+  'type',
+  '  TEagle = class',
+  '  end;',
+  '']);
+  ParseUnit;
+end;
+
 procedure TTestResolver.TestClass_Method;
 begin
   StartProgram(false);
@@ -9912,7 +10021,7 @@ begin
   Add('begin');
   Add('  if o.v=3 then ;');
   CheckResolverException('Can''t access private member v',
-    nCantAccessPrivateMember);
+    nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestClass_PrivateInDescendantFail;
@@ -9940,7 +10049,7 @@ begin
   Add('end;');
   Add('begin');
   CheckResolverException('Can''t access private member v',
-    nCantAccessPrivateMember);
+    nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestClass_ProtectedInDescendant;
@@ -10002,7 +10111,7 @@ begin
   Add('begin');
   Add('  if o.v=3 then ;');
   CheckResolverException('Can''t access strict private member v',
-    nCantAccessPrivateMember);
+    nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestClass_StrictProtectedInMainBeginFail;
@@ -10017,7 +10126,7 @@ begin
   Add('begin');
   Add('  if o.v=3 then ;');
   CheckResolverException('Can''t access strict protected member v',
-    nCantAccessPrivateMember);
+    nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestClass_Constructor_NewInstance;
@@ -10809,7 +10918,7 @@ begin
   '  Arm: TObject.TArm;',
   'begin',
   '']);
-  CheckResolverException('Can''t access strict private member TArm',nCantAccessPrivateMember);
+  CheckResolverException('Can''t access strict private member TArm',nCantAccessXMember);
 end;
 
 procedure TTestResolver.TestNestedClass_AccessStrictPrivate;
@@ -11580,6 +11689,42 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestPropertyReadAccessorStrictPrivate;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  strict private',
+  '    FSize: word;',
+  '    property Size: word read FSize;',
+  '  strict protected',
+  '    FName: string;',
+  '    property Name: string read FName;',
+  '  end;',
+  '  TBird = class',
+  '  strict protected',
+  '    property Caption: string read FName;',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorNonClassFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    FSize: word;',
+  '    class property Size: word read FSize;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('class var expected, but var found',nXExpectedButYFound);
+end;
+
 procedure TTestResolver.TestPropertyWriteAccessorVarWrongType;
 begin
   StartProgram(false);
@@ -12219,7 +12364,7 @@ begin
   '    constructor Create;',
   '  end;',
   'begin']);
-  CheckParserException(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
+  CheckParserException('constructor is not allowed in interface',nParserXNotAllowedInY);
 end;
 
 procedure TTestResolver.TestClassInterface_DelphiClassAncestorIntfFail;
@@ -15203,7 +15348,6 @@ begin
   '  PInteger = ^integer;',
   'var',
   '  i: integer;',
-  '  p1: PInteger;',
   'begin',
   '']);
   CheckResolverException('identifier not found "integer"',nIdentifierNotFound);
@@ -15544,6 +15688,24 @@ begin
     nDerivedXMustExtendASubClassY);
 end;
 
+procedure TTestResolver.ClassHelper_HelperForParentFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  type',
+  '    TBirdHelper = class helper for TBird',
+  '    end;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException(sTypeXIsNotYetCompletelyDefined,
+    nTypeXIsNotYetCompletelyDefined);
+end;
+
 procedure TTestResolver.ClassHelper_ForInterfaceFail;
 begin
   StartProgram(false);
@@ -15611,6 +15773,405 @@ begin
     nInvalidXModifierY);
 end;
 
+procedure TTestResolver.ClassHelper_VirtualDelphiFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure DoIt; virtual;',
+  '  end;',
+  'procedure TObjHelper.DoIt;',
+  'begin end;',
+  'begin',
+  '']);
+  CheckResolverException('Invalid class helper procedure modifier virtual',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.ClassHelper_DestructorFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    destructor Destroyer;',
+  '  end;',
+  'destructor TObjHelper.Destroyer;',
+  'begin end;',
+  'begin',
+  '']);
+  CheckParserException('destructor is not allowed in class helper',
+    nParserXNotAllowedInY);
+end;
+
+procedure TTestResolver.ClassHelper_ClassRefersToTypeHelperOfAncestor;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '  type',
+  '    TInt = word;',
+  '    function GetSize: TInt;',
+  '  end;',
+  '  TAnt = class',
+  '    procedure SetSize(Value: TInt);',
+  '    property Size: TInt read GetSize write SetSize;',
+  '  end;',
+  'function Tobjhelper.getSize: TInt;',
+  'begin',
+  'end;',
+  'procedure TAnt.SetSize(Value: TInt);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_InheritedObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure {#TObject_Fly}Fly;',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure {#TObjHelper_Fly}Fly;',
+  '  end;',
+  '  TBird = class',
+  '    procedure {#TBird_Fly}Fly;',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    procedure {#TBirdHelper_Fly}Fly;',
+  '    procedure {#TBirdHelper_Walk}Walk;',
+  '  end;',
+  '  TEagleHelper = class helper(TBirdHelper) for TBird',
+  '    procedure {#TEagleHelper_Fly}Fly;',
+  '    procedure {#TEagleHelper_Walk}Walk;',
+  '  end;',
+  'procedure Tobject.fly;',
+  'begin',
+  '  inherited;', // ignore
+  'end;',
+  'procedure Tobjhelper.fly;',
+  'begin',
+  '  {@TObject_Fly}inherited;',
+  '  inherited {@TObject_Fly}Fly;',
+  'end;',
+  'procedure Tbird.fly;',
+  'begin',
+  '  {@TObjHelper_Fly}inherited;',
+  '  inherited {@TObjHelper_Fly}Fly;',
+  'end;',
+  'procedure Tbirdhelper.fly;',
+  'begin',
+  '  {@TBird_Fly}inherited;',
+  '  inherited {@TBird_Fly}Fly;',
+  'end;',
+  'procedure Tbirdhelper.walk;',
+  'begin',
+  'end;',
+  'procedure teagleHelper.fly;',
+  'begin',
+  '  {@TBird_Fly}inherited;',
+  '  inherited {@TBird_Fly}Fly;',
+  'end;',
+  'procedure teagleHelper.walk;',
+  'begin',
+  '  {@TBirdHelper_Walk}inherited;',
+  '  inherited {@TBirdHelper_Walk}Walk;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_InheritedObjFPC2;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure {#TObject_Fly}Fly;',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure {#TObjHelper_Walk}Walk;',
+  '  end;',
+  '  TBird = class',
+  '    procedure {#TBird_Fly}Fly;',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    procedure {#TBirdHelper_Walk}Walk;',
+  '  end;',
+  '  TEagleHelper = class helper(TBirdHelper) for TBird',
+  '    procedure {#TEagleHelper_Walk}Walk;',
+  '  end;',
+  'procedure Tobject.fly;',
+  'begin',
+  '  inherited;', // ignore
+  'end;',
+  'procedure Tobjhelper.walk;',
+  'begin',
+  '  inherited;', // ignore
+  'end;',
+  'procedure Tbird.fly;',
+  'begin',
+  '  {@TObject_Fly}inherited;', // no helper, search further in ancestor
+  '  inherited {@TObject_Fly}Fly;', // no helper, search further in ancestor
+  'end;',
+  'procedure Tbirdhelper.walk;',
+  'begin',
+  '  {@TObjHelper_Walk}inherited;',
+  '  inherited {@TObjHelper_Walk}Walk;',
+  'end;',
+  'procedure teagleHelper.walk;',
+  'begin',
+  '  {@TObjHelper_Walk}inherited;',
+  '  inherited {@TObjHelper_Walk}Walk;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_InheritedObjFPCStrictPrivateFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  strict private i: word;',
+  '  end;',
+  '  THelper = class helper for TObject',
+  '    property a: word read i;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Can''t access strict private member i',nCantAccessXMember);
+end;
+
+procedure TTestResolver.ClassHelper_InheritedDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure {#TObject_Fly}Fly;',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure {#TObjHelper_Fly}Fly;',
+  '  end;',
+  '  TBird = class',
+  '    procedure {#TBird_Fly}Fly;',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    procedure {#TBirdHelper_Fly}Fly;',
+  '    procedure {#TBirdHelper_Walk}Walk;',
+  '  end;',
+  '  TEagleHelper = class helper(TBirdHelper) for TBird',
+  '    procedure {#TEagleHelper_Fly}Fly;',
+  '    procedure {#TEagleHelper_Walk}Walk;',
+  '  end;',
+  'procedure Tobject.fly;',
+  'begin',
+  '  inherited;', // ignore
+  'end;',
+  'procedure Tobjhelper.fly;',
+  'begin',
+  '  inherited;', // ignore
+  '  inherited {@TObject_Fly}Fly;',
+  'end;',
+  'procedure Tbird.fly;',
+  'begin',
+  '  {@TObjHelper_Fly}inherited;',
+  '  inherited {@TObjHelper_Fly}Fly;',
+  'end;',
+  'procedure Tbirdhelper.fly;',
+  'begin',
+  '  {@TObjHelper_Fly}inherited;',// skip helperfortype too
+  '  inherited {@TBird_Fly}Fly;',
+  'end;',
+  'procedure Tbirdhelper.walk;',
+  'begin',
+  'end;',
+  'procedure teagleHelper.fly;',
+  'begin',
+  '  {@TObjHelper_Fly}inherited;',// skip helperfortype too
+  '  inherited {@TBird_Fly}Fly;',
+  'end;',
+  'procedure teagleHelper.walk;',
+  'begin',
+  '  inherited;', // ignore
+  '  inherited {@TBirdHelper_Walk}Walk;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_NestedInheritedParentFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class',
+  '    procedure Fly;',
+  '  type',
+  '    TBirdHelper = class helper for TObject',
+  '      procedure Fly;',
+  '    end;',
+  '  end;',
+  'procedure TBird.fly;',
+  'begin',
+  'end;',
+  'procedure TBird.Tbirdhelper.fly;',
+  'begin',
+  '  inherited Fly;',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "Fly"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.ClassHelper_AccessFields;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    Size: word;',
+  '    FItems: array of word;',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    procedure Fly;',
+  '  end;',
+  'procedure TBirdHelper.Fly;',
+  'begin',
+  '  Size:=FItems[0];',
+  '  Self.Size:=Self.FItems[0];',
+  'end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  '  b.Fly;',
+  '  b.Fly()',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_CallClassMethodFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  THelper = class helper for TObject',
+  '    class procedure Fly;',
+  '  end;',
+  'class procedure THelper.Fly;',
+  'begin',
+  'end;',
+  'begin',
+  '  THelper.Fly;',
+  '']);
+  CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
+end;
+
+procedure TTestResolver.ClassHelper_AsTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  THelper = class helper for TObject',
+  '  end;',
+  'var h: THelper;',
+  'begin',
+  '']);
+  CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
+end;
+
+procedure TTestResolver.ClassHelper_Enumerator;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TItem = TObject;',
+  '  TEnumerator = class',
+  '    FCurrent: TItem;',
+  '    property Current: TItem read FCurrent;',
+  '    function MoveNext: boolean;',
+  '  end;',
+  '  TBird = class',
+  '    FItems: array of TItem;',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    function GetEnumerator: TEnumerator;',
+  '  end;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TBirdHelper.GetEnumerator: TEnumerator;',
+  'begin',
+  '  Result.FCurrent:=FItems[0];',
+  '  Result.FCurrent:=Self.FItems[0];',
+  'end;',
+  'var',
+  '  b: TBird;',
+  '  i: TItem;',
+  '  {#i2}i2: TItem;',
+  'begin',
+  '  for i in b do {@i2}i2:=i;']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_FromUnitInterface;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    Id: word;',
+    '  end;',
+    '  TObjHelper = class helper for TObject',
+    '    property Size: word read ID write ID;',
+    '  end;',
+    '']),
+    '');
+  AddModuleWithIntfImplSrc('unit3.pas',
+    LinesToStr([
+    'uses unit2;',
+    'type',
+    '  TObjHelper = class helper for TObject',
+    '    property Size: word read ID write ID;',
+    '  end;',
+    '']),
+    '');
+  StartProgram(true);
+  Add([
+  'uses unit2, unit3;',
+  'var o: TObject;',
+  'begin',
+  '  o.Size:=o.Size;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.RecordHelper;
 begin
   StartProgram(false);
@@ -15618,6 +16179,7 @@ begin
   '{$mode delphi}',
   'type',
   '  TRec = record',
+  '    x: word;',
   '  end;',
   '  TRecHelper = record helper for TRec',
   '  type T = word;',
@@ -15627,10 +16189,19 @@ begin
   '  class var',
   '    v: T;',
   '    w: T;',
+  '    procedure Fly;',
   '  end;',
   '  TAnt = word;',
   '  TAntHelper = record helper for TAnt',
   '  end;',
+  'procedure TRecHelper.Fly;',
+  'var r: TRec;',
+  'begin',
+  '  Self:=r;',
+  '  r:=Self;',
+  '  c:=v+x;',
+  '  x:=k+w;',
+  'end;',
   'begin',
   '']);
   ParseProgram;
@@ -15652,6 +16223,99 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TypeHelper_HelperForProcTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TProc = procedure;',
+  '  THelper = type helper for TProc',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type "TProc" cannot be extended by a type helper',
+    nTypeXCannotBeExtendedByATypeHelper);
+end;
+
+procedure TTestResolver.TypeHelper_DefaultPropertyFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TStringHelper = type helper for string',
+  '  end;',
+  '  TCaption = string;',
+  '  TCapHelper = type helper(TStringHelper) for TCaption',
+  '    function GetItems(Index: boolean): boolean;',
+  '    property Items[Index: boolean]: boolean read GetItems; default;',
+  '  end;',
+  'function TCapHelper.GetItems(Index: boolean): boolean; begin end;',
+  'begin',
+  '']);
+  CheckResolverException('Default property not allowed in helper for TCaption',
+    nDefaultPropertyNotAllowedInHelperForX);
+end;
+
+procedure TTestResolver.TypeHelper_Enum;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TFlag = (Red, Green, Blue);',
+  '  THelper = type helper for TFlag',
+  '    function toString: string;',
+  '  end;',
+  'function THelper.toString: string;',
+  'begin',
+  '  Self:=Red;',
+  '  if Self=TFlag.Blue then ;',
+  '  Result:=str(Self);',
+  'end;',
+  'var',
+  '  f: TFlag;',
+  'begin',
+  '  f.toString;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TypeHelper_Enumerator;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TObject = class end;',
+  '  TItem = byte;',
+  '  TEnumerator = class',
+  '    FCurrent: TItem;',
+  '    property Current: TItem read FCurrent;',
+  '    function MoveNext: boolean;',
+  '  end;',
+  '  TWordHelper = type helper for Word',
+  '    function GetEnumerator: TEnumerator;',
+  '  end;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TWordHelper.GetEnumerator: TEnumerator;',
+  'begin',
+  '  if Self=2 then ;',
+  '  Self:=Self+3;',
+  'end;',
+  'var',
+  '  w: word;',
+  '  i: TItem;',
+  '  {#i2}i2: TItem;',
+  'begin',
+  '  w.GetEnumerator;',
+  '  for i in w do {@i2}i2:=i;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestAttributes_Ignore;
 begin
   StartProgram(false);