fcl-passrc: resolver: check record/type helper static

git-svn-id: trunk@41188 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -161,7 +161,7 @@ const
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
   nMethodClassXInOtherUnitY = 3087;
-  nClassMethodsMustBeStaticInRecords = 3088;
+  nClassMethodsMustBeStaticInX = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportIndex = 3102;
@@ -290,7 +290,7 @@ resourcestring
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
-  sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
+  sClassMethodsMustBeStaticInX = 'Class methods must be static in %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';

packages/fcl-passrc/src/pasresolver.pp

@@ -5854,7 +5854,7 @@ begin
       end;
 
     IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
-      or (Proc.ClassType=TPasClassDestructor);
+                       or (Proc.ClassType=TPasClassDestructor);
     if IsClassConDestructor then
       begin
       // class constructor/destructor
@@ -5897,6 +5897,11 @@ begin
           RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
         if Proc.IsOverride then
           RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
+        if (ObjKind<>okClassHelper) and IsClassMethod(Proc) then
+          begin
+          if not Proc.IsStatic then
+            RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
+          end;
         end;
       end;
       if Proc.IsAbstract then
@@ -5933,13 +5938,10 @@ begin
         RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
       if Proc.IsForward then
         RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
-      if (Proc.ClassType=TPasClassProcedure)
-          or (Proc.ClassType=TPasClassFunction)
-          or (Proc.ClassType=TPasClassConstructor)
-          or (Proc.ClassType=TPasClassDestructor) then
+      if IsClassMethod(Proc) then
         begin
         if not Proc.IsStatic then
-          RaiseMsg(20190106121503,nClassMethodsMustBeStaticInRecords,sClassMethodsMustBeStaticInRecords,[],Proc);
+          RaiseMsg(20190106121503,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,['records'],Proc);
         end;
       end
     else

packages/fcl-passrc/tests/tcresolver.pas

@@ -887,9 +887,10 @@ type
     Procedure TestClassHelper_InheritedDelphi;
     Procedure TestClassHelper_NestedInheritedParentFail;
     Procedure TestClassHelper_AccessFields;
-    Procedure TestClassHelper_CallClassMethodFail;
+    Procedure TestClassHelper_HelperDotClassMethodFail;
     Procedure TestClassHelper_WithHelperFail;
     Procedure TestClassHelper_AsTypeFail;
+    Procedure TestClassHelper_ClassMethod;
     Procedure TestClassHelper_Enumerator;
     Procedure TestClassHelper_FromUnitInterface;
     Procedure TestClassHelper_Constructor_NewInstance;
@@ -898,6 +899,7 @@ type
     Procedure TestClassHelper_DefaultClassProperty;
     Procedure TestClassHelper_MultipleScopeHelpers;
     Procedure TestRecordHelper;
+    Procedure TestRecordHelper_ClassNonStaticFail;
     Procedure TestRecordHelper_InheritedObjFPC;
     Procedure TestRecordHelper_Constructor_NewInstance;
     Procedure TestTypeHelper;
@@ -16226,7 +16228,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClassHelper_CallClassMethodFail;
+procedure TTestResolver.TestClassHelper_HelperDotClassMethodFail;
 begin
   StartProgram(false);
   Add([
@@ -16272,6 +16274,66 @@ begin
   CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
 end;
 
+procedure TTestResolver.TestClassHelper_ClassMethod;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  THelper = class helper for TObject',
+  '    class procedure Fly(w: word = 1);',
+  '    class procedure Run(w: word = 1); static;',
+  '  end;',
+  'class procedure THelper.Fly(w: word = 1);',
+  'begin',
+  '  Fly;',
+  '  Fly();',
+  '  Run;',
+  '  Run();',
+  '  Self.Fly;',
+  '  Self.Fly();',
+  '  Self.Run;',
+  '  Self.Run();',
+  '  with Self do begin',
+  '    Fly;',
+  '    Fly();',
+  '    Run;',
+  '    Run();',
+  '  end;',
+  'end;',
+  'class procedure THelper.Run(w: word = 1);',
+  'begin',
+  '  Fly;',
+  '  Fly();',
+  '  Run;',
+  '  Run();',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o.Fly;',
+  '  o.Fly();',
+  '  o.Run;',
+  '  o.Run();',
+  '  with o do begin',
+  '    Fly;',
+  '    Fly();',
+  '    Run;',
+  '    Run();',
+  '  end;',
+  '  TObject.Fly;',
+  '  TObject.Fly();',
+  '  TObject.Run;',
+  '  TObject.Run();',
+  '  with TObject do begin',
+  '    Fly;',
+  '    Fly();',
+  '    Run;',
+  '    Run();',
+  '  end;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClassHelper_Enumerator;
 begin
   StartProgram(false);
@@ -16583,6 +16645,26 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecordHelper_ClassNonStaticFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TRec = record',
+  '    x: word;',
+  '  end;',
+  '  TRecHelper = record helper for TRec',
+  '    class procedure Fly;',
+  '  end;',
+  'class procedure TRecHelper.Fly;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Class methods must be static in record helper',nClassMethodsMustBeStaticInX);
+end;
+
 procedure TTestResolver.TestRecordHelper_InheritedObjFPC;
 begin
   StartProgram(false);
@@ -16786,7 +16868,7 @@ begin
   '  TFlag = (Red, Green, Blue);',
   '  THelper = type helper for TFlag',
   '    function toString: string;',
-  '    class procedure Fly;',
+  '    class procedure Fly; static;',
   '  end;',
   'function THelper.toString: string;',
   'begin',