Browse Source

fcl-passrc: parser: local and anonymous records cannot be advanced, resolver: adv records: recordvalues, class methods must be static, sub class

git-svn-id: trunk@40795 -
Mattias Gaertner 6 years ago
parent
commit
5efbfcc2b0

+ 4 - 2
packages/fcl-passrc/src/pasresolveeval.pas

@@ -154,14 +154,14 @@ const
   nMethodHidesMethodOfBaseType = 3077;
   nMethodHidesMethodOfBaseType = 3077;
   nContextExpectedXButFoundY = 3078;
   nContextExpectedXButFoundY = 3078;
   nContextXInvalidY = 3079;
   nContextXInvalidY = 3079;
-  // free 3080;
+  nIdentifierXIsNotAnInstanceField = 3080;
   nXIsNotSupported = 3081;
   nXIsNotSupported = 3081;
   nOperatorIsNotOverloadedAOpB = 3082;
   nOperatorIsNotOverloadedAOpB = 3082;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
   nIllegalQualifierWithin = 3086;
   nMethodClassXInOtherUnitY = 3087;
   nMethodClassXInOtherUnitY = 3087;
-  // free 3088
+  nClassMethodsMustBeStaticInRecords = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportIndex = 3102;
   nImplementsDoesNotSupportIndex = 3102;
@@ -277,6 +277,7 @@ resourcestring
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextXInvalidY = '%s: invalid %s';
   sContextXInvalidY = '%s: invalid %s';
+  sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sXIsNotSupported = '%s is not supported';
   sXIsNotSupported = '%s is not supported';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
@@ -285,6 +286,7 @@ resourcestring
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
+  sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';

+ 77 - 40
packages/fcl-passrc/src/pasresolver.pp

@@ -913,7 +913,7 @@ type
     DeclarationProc: TPasProcedure; // the corresponding forward declaration
     DeclarationProc: TPasProcedure; // the corresponding forward declaration
     ImplProc: TPasProcedure; // the corresponding proc with Body
     ImplProc: TPasProcedure; // the corresponding proc with Body
     OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
     OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
-    ClassScope: TPasClassOrRecordScope;
+    ClassOrRecordScope: TPasClassOrRecordScope;
     SelfArg: TPasArgument;
     SelfArg: TPasArgument;
     Flags: TPasProcedureScopeFlags;
     Flags: TPasProcedureScopeFlags;
     BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
     BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
@@ -1860,7 +1860,7 @@ type
     function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
     function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
     function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
     function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
       PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
       PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
-    function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
+    function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
     // utility functions
     // utility functions
     function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
     function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
     function GetElModeSwitches(El: TPasElement): TModeSwitches;
     function GetElModeSwitches(El: TPasElement): TModeSwitches;
@@ -2975,7 +2975,7 @@ var
 begin
 begin
   Result:=inherited FindIdentifier(Identifier);
   Result:=inherited FindIdentifier(Identifier);
   if Result<>nil then exit;
   if Result<>nil then exit;
-  CurScope:=ClassScope;
+  CurScope:=ClassOrRecordScope;
   if CurScope=nil then exit;
   if CurScope=nil then exit;
   repeat
   repeat
     Result:=CurScope.FindIdentifier(Identifier);
     Result:=CurScope.FindIdentifier(Identifier);
@@ -3000,7 +3000,7 @@ var
 begin
 begin
   inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
   inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
   if Abort then exit;
   if Abort then exit;
-  CurScope:=ClassScope;
+  CurScope:=ClassOrRecordScope;
   if CurScope=nil then exit;
   if CurScope=nil then exit;
   repeat
   repeat
     CurScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
     CurScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
@@ -3022,7 +3022,7 @@ var
 begin
 begin
   Result:=Self;
   Result:=Self;
   repeat
   repeat
-    if Result.ClassScope<>nil then exit;
+    if Result.ClassOrRecordScope<>nil then exit;
     Proc:=TPasProcedure(Element);
     Proc:=TPasProcedure(Element);
     if not (Proc.Parent is TProcedureBody) then exit(nil);
     if not (Proc.Parent is TProcedureBody) then exit(nil);
     Proc:=Proc.Parent.Parent as TPasProcedure;
     Proc:=Proc.Parent.Parent as TPasProcedure;
@@ -3033,8 +3033,8 @@ end;
 procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
 procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
 begin
 begin
   inherited WriteIdentifiers(Prefix);
   inherited WriteIdentifiers(Prefix);
-  if ClassScope<>nil then
-    ClassScope.WriteIdentifiers(Prefix+'CS  ');
+  if ClassOrRecordScope<>nil then
+    ClassOrRecordScope.WriteIdentifiers(Prefix+'CS  ');
 end;
 end;
 
 
 destructor TPasProcedureScope.Destroy;
 destructor TPasProcedureScope.Destroy;
@@ -5569,9 +5569,14 @@ begin
         RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
         RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
       if Proc.IsForward then
       if Proc.IsForward then
         RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
         RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
-      if Proc.IsStatic then
-        if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
-          RaiseMsg(20181218195519,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'static'],Proc);
+      if (Proc.ClassType=TPasClassProcedure)
+          or (Proc.ClassType=TPasClassFunction)
+          or (Proc.ClassType=TPasClassConstructor)
+          or (Proc.ClassType=TPasClassDestructor) then
+        begin
+        if not Proc.IsStatic then
+          RaiseMsg(20190106121503,nClassMethodsMustBeStaticInRecords,sClassMethodsMustBeStaticInRecords,[],Proc);
+        end;
       end
       end
     else
     else
       begin
       begin
@@ -5742,7 +5747,7 @@ begin
   // ToDo: store the scanner flags *before* it has parsed the token after the proc
   // ToDo: store the scanner flags *before* it has parsed the token after the proc
   StoreScannerFlagsInProc(ProcScope);
   StoreScannerFlagsInProc(ProcScope);
   ClassOrRecScope:=Scopes[ScopeCount-2] as TPasClassOrRecordScope;
   ClassOrRecScope:=Scopes[ScopeCount-2] as TPasClassOrRecordScope;
-  ProcScope.ClassScope:=ClassOrRecScope;
+  ProcScope.ClassOrRecordScope:=ClassOrRecScope;
   FindData:=Default(TFindOverloadProcData);
   FindData:=Default(TFindOverloadProcData);
   FindData.Proc:=Proc;
   FindData.Proc:=Proc;
   FindData.Args:=Proc.ProcType.Args;
   FindData.Args:=Proc.ProcType.Args;
@@ -5842,7 +5847,7 @@ begin
 
 
   // search proc in class/record
   // search proc in class/record
   ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
   ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
-  ClassOrRecScope:=ImplProcScope.ClassScope;
+  ClassOrRecScope:=ImplProcScope.ClassOrRecordScope;
   if ClassOrRecScope=nil then
   if ClassOrRecScope=nil then
     RaiseInternalError(20161013172346);
     RaiseInternalError(20161013172346);
   ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
   ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
@@ -5881,7 +5886,7 @@ begin
         or (DeclProc.ClassType=TPasClassProcedure)
         or (DeclProc.ClassType=TPasClassProcedure)
         or (DeclProc.ClassType=TPasClassFunction) then
         or (DeclProc.ClassType=TPasClassFunction) then
       begin
       begin
-      if (not DeclProc.IsStatic) and (ClassOrRecScope is TPasClassScope) then
+      if ClassOrRecScope is TPasClassScope then
         begin
         begin
         // 'Self' in a class proc is the hidden classtype argument
         // 'Self' in a class proc is the hidden classtype argument
         SelfArg:=TPasArgument.Create('Self',DeclProc);
         SelfArg:=TPasArgument.Create('Self',DeclProc);
@@ -5891,7 +5896,9 @@ begin
         SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
         SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
         SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
         SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
         AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
         AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
-        end;
+        end
+      else
+        RaiseInternalError(20190106121745);
       end
       end
     else
     else
       begin
       begin
@@ -6071,6 +6078,14 @@ var
       end;
       end;
   end;
   end;
 
 
+  function ExpectedClassAccessorStatic: boolean;
+  begin
+    if (ClassScope<>nil) and (proClassPropertyNonStatic in Options) then
+      Result:=false
+    else
+      Result:=true;
+  end;
+
   procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
   procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
     ProcArg: TPasArgument; ErrorEl: TPasElement);
     ProcArg: TPasArgument; ErrorEl: TPasElement);
   var
   var
@@ -6476,7 +6491,7 @@ begin
           begin
           begin
           if Proc.ClassType<>TPasClassFunction then
           if Proc.ClassType<>TPasClassFunction then
             RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
             RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
-          if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
+          if Proc.IsStatic<>ExpectedClassAccessorStatic then
             if Proc.IsStatic then
             if Proc.IsStatic then
               RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
               RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
             else
             else
@@ -6531,11 +6546,11 @@ begin
           begin
           begin
           if Proc.ClassType<>TPasClassProcedure then
           if Proc.ClassType<>TPasClassProcedure then
             RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
             RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
-            if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
-              if Proc.IsStatic then
-                RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
-              else
-                RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
+          if Proc.IsStatic<>ExpectedClassAccessorStatic then
+            if Proc.IsStatic then
+              RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
+            else
+              RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
           end
           end
         else
         else
           begin
           begin
@@ -6617,12 +6632,22 @@ var
   DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
   DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
   AncestorClassEl: TPasClassType;
   AncestorClassEl: TPasClassType;
 
 
+  function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
+  begin
+    Result:=SameText(c.Name,DefAncestorName)
+        and (c.Parent is TPasSection);
+  end;
+
   procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
   procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
   var
   var
     CurEl: TPasElement;
     CurEl: TPasElement;
   begin
   begin
     AncestorClassEl:=nil;
     AncestorClassEl:=nil;
-    if (CompareText(aClass.Name,DefAncestorName)=0) then exit;
+    if SameText(aClass.Name,DefAncestorName) then
+      begin
+      if IsDefaultAncestor(aClass,DefAncestorName) then exit;
+      RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
+      end;
     CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false);
     CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false);
     if not (CurEl is TPasType) then
     if not (CurEl is TPasType) then
       RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
       RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
@@ -6715,7 +6740,7 @@ begin
     okClass:
     okClass:
       begin
       begin
       DefAncestorName:='TObject';
       DefAncestorName:='TObject';
-      if (CompareText(aClass.Name,DefAncestorName)=0) or aClass.IsExternal then
+      if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
         begin
         begin
           // ok, no ancestor
           // ok, no ancestor
           AncestorClassEl:=nil;
           AncestorClassEl:=nil;
@@ -6736,7 +6761,7 @@ begin
           DefAncestorName:='IInterface'
           DefAncestorName:='IInterface'
         else
         else
           DefAncestorName:='IUnknown';
           DefAncestorName:='IUnknown';
-        if SameText(DefAncestorName,aClass.Name) then
+        if IsDefaultAncestor(aClass,DefAncestorName) then
           AncestorClassEl:=nil
           AncestorClassEl:=nil
         else
         else
           begin
           begin
@@ -8128,7 +8153,7 @@ begin
   SelfScope:=ProcScope.GetSelfScope;
   SelfScope:=ProcScope.GetSelfScope;
   if SelfScope=nil then
   if SelfScope=nil then
     RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
     RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
-  ClassRecScope:=SelfScope.ClassScope;
+  ClassRecScope:=SelfScope.ClassOrRecordScope;
 
 
   AncestorScope:=nil;
   AncestorScope:=nil;
   if ClassRecScope is TPasClassScope then
   if ClassRecScope is TPasClassScope then
@@ -8183,7 +8208,7 @@ begin
   SelfScope:=ProcScope.GetSelfScope;
   SelfScope:=ProcScope.GetSelfScope;
   if SelfScope=nil then
   if SelfScope=nil then
     RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
     RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
-  ClassRecScope:=SelfScope.ClassScope;
+  ClassRecScope:=SelfScope.ClassOrRecordScope;
 
 
   AncestorScope:=nil;
   AncestorScope:=nil;
   if ClassRecScope is TPasClassScope then
   if ClassRecScope is TPasClassScope then
@@ -8895,7 +8920,7 @@ procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
       if SameText(Result.Name,aName) then
       if SameText(Result.Name,aName) then
         exit;
         exit;
       end;
       end;
-    if (RecType.VariantEl is TPasVariable) then
+    if RecType.VariantEl is TPasVariable then
       begin
       begin
       Result:=TPasVariable(RecType.VariantEl);
       Result:=TPasVariable(RecType.VariantEl);
       if SameText(Result.Name,aName) then
       if SameText(Result.Name,aName) then
@@ -8938,9 +8963,12 @@ begin
     Member:=GetMember(RecType,Field^.Name);
     Member:=GetMember(RecType,Field^.Name);
     if Member=nil then
     if Member=nil then
       RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
       RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
-    if not (Member is TPasVariable) then
-      RaiseMsg(20180429121933,nVariableIdentifierExpected,sVariableIdentifierExpected,
+    if Member.ClassType<>TPasVariable then
+      RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
         [],Field^.ValueExp);
         [],Field^.ValueExp);
+    if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
+      RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
+        ['record assignment'],Field^.ValueExp);
     CreateReference(Member,Field^.NameExp,rraAssign);
     CreateReference(Member,Field^.NameExp,rraAssign);
     // check duplicates
     // check duplicates
     for j:=0 to i-1 do
     for j:=0 to i-1 do
@@ -8957,7 +8985,9 @@ begin
   for i:=0 to RecType.Members.Count-1 do
   for i:=0 to RecType.Members.Count-1 do
     begin
     begin
     Member:=TPasElement(RecType.Members[i]);
     Member:=TPasElement(RecType.Members[i]);
-    if not (Member is TPasVariable) then continue;
+    if Member.ClassType<>TPasVariable then continue;
+    if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
+      continue;
     j:=length(El.Fields)-1;
     j:=length(El.Fields)-1;
     while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
     while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
       dec(j);
       dec(j);
@@ -9232,7 +9262,7 @@ var
   i: Integer;
   i: Integer;
   DeclEl: TPasElement;
   DeclEl: TPasElement;
   Proc: TPasProcedure;
   Proc: TPasProcedure;
-  aClassType: TPasClassType;
+  aClassOrRec: TPasMembersType;
 begin
 begin
   if IsElementSkipped(El) then exit;
   if IsElementSkipped(El) then exit;
   if El is TPasDeclarations then
   if El is TPasDeclarations then
@@ -9250,13 +9280,15 @@ begin
         end;
         end;
       end;
       end;
     end
     end
-  else if El.ClassType=TPasClassType then
+  else if El is TPasMembersType then
     begin
     begin
-    aClassType:=TPasClassType(El);
-    if aClassType.ObjKind in [okInterface,okDispInterface] then exit;
-    for i:=0 to aClassType.Members.Count-1 do
+    aClassOrRec:=TPasMembersType(El);
+    if (aClassOrRec is TPasClassType)
+        and (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface])
+        then exit;
+    for i:=0 to aClassOrRec.Members.Count-1 do
       begin
       begin
-      DeclEl:=TPasElement(aClassType.Members[i]);
+      DeclEl:=TPasElement(aClassOrRec.Members[i]);
       if DeclEl is TPasProcedure then
       if DeclEl is TPasProcedure then
         begin
         begin
         Proc:=TPasProcedure(DeclEl);
         Proc:=TPasProcedure(DeclEl);
@@ -9660,7 +9692,7 @@ begin
       RaiseNotYetImplemented(20161013170956,El);
       RaiseNotYetImplemented(20161013170956,El);
 
 
     ProcScope.VisibilityContext:=ClassOrRecType;
     ProcScope.VisibilityContext:=ClassOrRecType;
-    ProcScope.ClassScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
+    ProcScope.ClassOrRecordScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
     end;// HasDot=true
     end;// HasDot=true
 end;
 end;
 
 
@@ -15084,7 +15116,7 @@ begin
           and (TPasWithExprScope(StartScope).Scope is TPasClassOrRecordScope) then
           and (TPasWithExprScope(StartScope).Scope is TPasClassOrRecordScope) then
         ClassRecScope:=TPasClassOrRecordScope(TPasWithExprScope(StartScope).Scope)
         ClassRecScope:=TPasClassOrRecordScope(TPasWithExprScope(StartScope).Scope)
       else if (StartScope is TPasProcedureScope) then
       else if (StartScope is TPasProcedureScope) then
-        ClassRecScope:=TPasProcedureScope(StartScope).ClassScope
+        ClassRecScope:=TPasProcedureScope(StartScope).ClassOrRecordScope
       else
       else
         RaiseInternalError(20170131150855,GetObjName(StartScope));
         RaiseInternalError(20170131150855,GetObjName(StartScope));
       TypeEl:=ClassRecScope.Element as TPasType;
       TypeEl:=ClassRecScope.Element as TPasType;
@@ -18271,7 +18303,7 @@ begin
     exit(NotLocked(IdentEl));
     exit(NotLocked(IdentEl));
 end;
 end;
 
 
-function TPasResolver.ResolvedElIsClassInstance(
+function TPasResolver.ResolvedElIsClassOrRecordInstance(
   const ResolvedEl: TPasResolverResult): boolean;
   const ResolvedEl: TPasResolverResult): boolean;
 var
 var
   TypeEl: TPasType;
   TypeEl: TPasType;
@@ -18280,8 +18312,13 @@ begin
   if ResolvedEl.BaseType<>btContext then exit;
   if ResolvedEl.BaseType<>btContext then exit;
   TypeEl:=ResolvedEl.LoTypeEl;
   TypeEl:=ResolvedEl.LoTypeEl;
   if TypeEl=nil then exit;
   if TypeEl=nil then exit;
-  if TypeEl.ClassType<>TPasClassType then exit;
-  if TPasClassType(TypeEl).ObjKind<>okClass then exit;
+  if TypeEl.ClassType=TPasClassType then
+    begin
+    if TPasClassType(TypeEl).ObjKind<>okClass then exit;
+    end
+  else if TypeEl.ClassType=TPasRecordType then
+  else
+    exit;
   if (ResolvedEl.IdentEl is TPasVariable)
   if (ResolvedEl.IdentEl is TPasVariable)
       or (ResolvedEl.IdentEl.ClassType=TPasArgument)
       or (ResolvedEl.IdentEl.ClassType=TPasArgument)
       or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
       or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then

+ 14 - 3
packages/fcl-passrc/src/pparser.pp

@@ -3557,7 +3557,9 @@ begin
              RecordEl.SetGenericTemplates(List);
              RecordEl.SetGenericTemplates(List);
              NextToken;
              NextToken;
              ParseRecordFieldList(RecordEl,tkend,
              ParseRecordFieldList(RecordEl,tkend,
-                              msAdvancedRecords in Scanner.CurrentModeSwitches);
+                              (msAdvancedRecords in Scanner.CurrentModeSwitches)
+                              and not (Declarations is TProcedureBody)
+                              and (RecordEl.Name<>''));
              CheckHint(RecordEl,True);
              CheckHint(RecordEl,True);
              Engine.FinishScope(stTypeDef,RecordEl);
              Engine.FinishScope(stTypeDef,RecordEl);
              end;
              end;
@@ -6344,7 +6346,15 @@ begin
       tkClass:
       tkClass:
         begin
         begin
         if Not AllowMethods then
         if Not AllowMethods then
-          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
+          begin
+          NextToken;
+          case CurToken of
+          tkConst: ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
+          tkvar: ParseExc(nErrRecordVariablesNotAllowed,SErrRecordVariablesNotAllowed);
+          else
+            ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
+          end;
+          end;
         if isClass then
         if isClass then
           ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
           ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
         isClass:=True;
         isClass:=True;
@@ -6437,7 +6447,8 @@ begin
   try
   try
     Result.PackMode:=PackMode;
     Result.PackMode:=PackMode;
     NextToken;
     NextToken;
-    ParseRecordFieldList(Result,tkEnd,msAdvancedRecords in Scanner.CurrentModeSwitches);
+    ParseRecordFieldList(Result,tkEnd,
+      (msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
     Engine.FinishScope(stTypeDef,Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
     ok:=true;
   finally
   finally

+ 110 - 5
packages/fcl-passrc/tests/tcresolver.pas

@@ -490,7 +490,10 @@ type
     Procedure TestAdvRecord;
     Procedure TestAdvRecord;
     Procedure TestAdvRecord_Private;
     Procedure TestAdvRecord_Private;
     Procedure TestAdvRecord_StrictPrivate;
     Procedure TestAdvRecord_StrictPrivate;
+    Procedure TestAdvRecord_MethodImplMissingFail;
     Procedure TestAdvRecord_VarConst;
     Procedure TestAdvRecord_VarConst;
+    Procedure TestAdvRecord_RecVal_ConstFail;
+    Procedure TestAdvRecord_RecVal_ClassVarFail;
     Procedure TestAdvRecord_LocalForwardType;
     Procedure TestAdvRecord_LocalForwardType;
     Procedure TestAdvRecord_Constructor_NewInstance;
     Procedure TestAdvRecord_Constructor_NewInstance;
     Procedure TestAdvRecord_ConstructorNoParamsFail;
     Procedure TestAdvRecord_ConstructorNoParamsFail;
@@ -504,6 +507,8 @@ type
     Procedure TestAdvRecord_RecordAsFuncResult;
     Procedure TestAdvRecord_RecordAsFuncResult;
     Procedure TestAdvRecord_InheritedFail;
     Procedure TestAdvRecord_InheritedFail;
     Procedure TestAdvRecord_ForInEnumerator;
     Procedure TestAdvRecord_ForInEnumerator;
+    Procedure TestAdvRecord_InFunctionFail;
+    Procedure TestAdvRecord_SubClass;
 
 
     // class
     // class
     Procedure TestClass;
     Procedure TestClass;
@@ -7874,6 +7879,20 @@ begin
   CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
   CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_MethodImplMissingFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    procedure SetSize(Value: word);',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
 procedure TTestResolver.TestAdvRecord_VarConst;
 procedure TTestResolver.TestAdvRecord_VarConst;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7913,6 +7932,42 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_RecVal_ConstFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    V1: word;',
+  '  const',
+  '    C1 = 3;',
+  '  end;',
+  'var',
+  '  r: TRec = (V1:2; C1: 4);',
+  'begin',
+  '']);
+  CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
+end;
+
+procedure TTestResolver.TestAdvRecord_RecVal_ClassVarFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    V1: word;',
+  '  class var',
+  '    C1: word;',
+  '  end;',
+  'var',
+  '  r: TRec = (V1:2; C1: 4);',
+  'begin',
+  '']);
+  CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
+end;
+
 procedure TTestResolver.TestAdvRecord_LocalForwardType;
 procedure TTestResolver.TestAdvRecord_LocalForwardType;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7947,7 +8002,7 @@ begin
   'type',
   'type',
   '  TRec = record',
   '  TRec = record',
   '    constructor Create(w: word);',
   '    constructor Create(w: word);',
-  '    class function DoSome: TRec;',
+  '    class function DoSome: TRec; static;',
   '  end;',
   '  end;',
   'constructor TRec.Create(w: word);',
   'constructor TRec.Create(w: word);',
   'begin',
   'begin',
@@ -8027,14 +8082,17 @@ begin
   '{$modeswitch advancedrecords}',
   '{$modeswitch advancedrecords}',
   'type',
   'type',
   '  TRec = record',
   '  TRec = record',
-  '    class procedure {#a}Create;',
-  '    class constructor Create;',
+  '    class var w: word;',
+  '    class procedure {#a}Create; static;',
+  '    class constructor Create; static;',
   '  end;',
   '  end;',
   'class constructor TRec.Create;',
   'class constructor TRec.Create;',
   'begin',
   'begin',
+  '  w:=w+1;',
   'end;',
   'end;',
   'class procedure TRec.Create;',
   'class procedure TRec.Create;',
   'begin',
   'begin',
+  '  w:=w+1;',
   'end;',
   'end;',
   'begin',
   'begin',
   '  TRec.{@a}Create;',
   '  TRec.{@a}Create;',
@@ -8231,8 +8289,8 @@ begin
   'type',
   'type',
   '  {#A}TRec = record',
   '  {#A}TRec = record',
   '     {#A_i}i: longint;',
   '     {#A_i}i: longint;',
-  '     class function {#A_CreateA}Create: TRec;',
-  '     class function {#A_CreateB}Create(i: longint): TRec;',
+  '     class function {#A_CreateA}Create: TRec; static;',
+  '     class function {#A_CreateB}Create(i: longint): TRec; static;',
   '  end;',
   '  end;',
   'function {#F}F: TRec;',
   'function {#F}F: TRec;',
   'begin',
   'begin',
@@ -8313,6 +8371,53 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_InFunctionFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'procedure DoIt;',
+  'type',
+  '  TBird = record',
+  '    class var i: word;',
+  '  end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException(sErrRecordVariablesNotAllowed,nErrRecordVariablesNotAllowed);
+end;
+
+procedure TTestResolver.TestAdvRecord_SubClass;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TObject = class end;',
+  '  TPoint = record',
+  '  type',
+  '    TBird = class',
+  '      procedure DoIt;',
+  '      class procedure Glob;',
+  '    end;',
+  '    procedure DoIt(b: TBird);',
+  '  end;',
+  'procedure TPoint.TBird.DoIt;',
+  'begin',
+  'end;',
+  'class procedure TPoint.TBird.Glob;',
+  'begin',
+  'end;',
+  'procedure TPoint.DoIt(b: TBird);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 procedure TTestResolver.TestClass;
 begin
 begin
   StartProgram(false);
   StartProgram(false);