paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-23 22:34:21 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@41188 -
This commit is contained in:
Mattias Gaertner 2019-02-03 16:28:25 +00:00
parent 91fd2396fc
commit 07d6c5b688
3 changed files with 95 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -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"';

12
packages/fcl-passrc/src/pasresolver.pp
View File

@ -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

88
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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',