paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 02:27:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: allow static directive repetition in method implementation

Browse Source
This commit is contained in:
mattias 2020-04-25 13:54:47 +00:00
parent e89569f361
commit dd3581a9ac
3 changed files with 31 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -186,6 +186,7 @@ const
nWrongTypeXInArrayConstructor = 3120;
nMethodHidesNonVirtualMethodExactly = 3125;
nDuplicatePublishedMethodXAtY = 3126;
nDirectiveXNotAllowedHere = 3143;
// using same IDs as FPC
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@ -319,6 +320,7 @@ resourcestring
sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
sDuplicatePublishedMethodXAtY = 'Duplicate published method "%s" at %s';
sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
type
{ TResolveData - base class for data stored in TPasElement.CustomData }

15
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -6026,7 +6026,7 @@ begin
RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
if Proc.IsMessage then
RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
if Proc.IsStatic then
if Proc.IsStatic and not HasDots then
RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
if (not HasDots)
and (Proc.GetProcTypeEnum in [
@ -7943,11 +7943,11 @@ var
DeclArgs, ImplArgs: TFPList;
DeclName, ImplName: String;
ImplResult, DeclResult: TPasType;
NewImplPTMods: TProcTypeModifiers;
ptm: TProcTypeModifier;
begin
if ImplProc.ClassType<>DeclProc.ClassType then
RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
if ImplProc.CallingConvention<>DeclProc.CallingConvention then
RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
if ImplProc.ProcType is TPasFunctionType then
begin
// check result type
@ -7973,6 +7973,15 @@ begin
sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
end;
end;
// modifiers
if ImplProc.CallingConvention<>DeclProc.CallingConvention then
RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
NewImplPTMods:=ImplProc.ProcType.Modifiers-DeclProc.ProcType.Modifiers;
if NewImplPTMods<>[] then
for ptm in NewImplPTMods do
RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
[ProcTypeModifiers[ptm]],ImplProc.ProcType);
end;
procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);

18
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -593,6 +593,7 @@ type
Procedure TestClass_StaticWithoutClassFail;
Procedure TestClass_SelfInStaticFail;
Procedure TestClass_SelfDotInStaticFail;
Procedure TestClass_ProcStaticMismatchFail;
Procedure TestClass_PrivateProtectedInSameUnit;
Procedure TestClass_PrivateInMainBeginFail;
Procedure TestClass_PrivateInDescendantFail;
@ -8382,7 +8383,7 @@ begin
'begin',
' w:=w+1;',
'end;',
'class procedure TRec.Create;',
'class procedure TRec.Create; static;',
'begin',
' w:=w+1;',
'end;',
@ -10254,6 +10255,21 @@ begin
CheckResolverException('identifier not found "Self"',nIdentifierNotFound);
end;
procedure TTestResolver.TestClass_ProcStaticMismatchFail;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' procedure Run;',
' end;',
'procedure TObject.Run; static;',
'begin',
'end;',
'begin']);
CheckResolverException('Directive "static" not allowed here',nDirectiveXNotAllowedHere);
end;
procedure TTestResolver.TestClass_PrivateProtectedInSameUnit;
begin
StartProgram(false);