paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 09:28:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/z80@45079 -
This commit is contained in:
nickysn 2020-04-25 21:13:31 +00:00
commit df65884b7e
5 changed files with 40 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/x86/aoptx86.pas
View File

@ -5232,7 +5232,13 @@ unit aoptx86;
if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
begin
DebugMsg(SPeepholeOptimization + 'MovxMov2Movx',p);
taicpu(p).loadreg(1,taicpu(hp1).oper[1]^.reg);
{$ifdef x86_64}
if (taicpu(p).opsize in [S_BL,S_WL]) and
(taicpu(hp1).opsize=S_Q) then
taicpu(p).loadreg(1,newreg(R_INTREGISTER,getsupreg(taicpu(hp1).oper[1]^.reg),R_SUBD))
else
{$endif x86_64}
taicpu(p).loadreg(1,taicpu(hp1).oper[1]^.reg);
asml.remove(hp1);
hp1.Free;
end;

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

@ -206,6 +206,7 @@ const
nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
nParamOfThisTypeCannotHaveDefVal = 3141;
nClassTypesAreNotRelatedXY = 3142;
nDirectiveXNotAllowedHere = 3143;
// using same IDs as FPC
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@ -359,6 +360,7 @@ resourcestring
sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
type
{ TResolveData - base class for data stored in TPasElement.CustomData }

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

@ -5189,7 +5189,7 @@ begin
fpkProc:
// proc hides a non proc
if (Data^.Proc.GetModule=El.GetModule) then
// forbidden within same CurModule
// forbidden within same module
RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
[El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
else
@ -6930,7 +6930,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 [
@ -9205,11 +9205,11 @@ var
DeclName, ImplName: String;
ImplResult, DeclResult: TPasType;
ImplTemplType, DeclTemplType: TPasGenericTemplateType;
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);
DeclArgs:=DeclProc.ProcType.Args;
ImplArgs:=ImplProc.ProcType.Args;
@ -9273,6 +9273,15 @@ begin
RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
[],DeclResult,ImplResult,ImplProc);
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
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -601,6 +601,7 @@ type
Procedure TestClass_StaticWithoutClassFail;
Procedure TestClass_SelfInStaticFail;
Procedure TestClass_SelfDotInStaticFail;
Procedure TestClass_ProcStaticMismatchFail;
Procedure TestClass_PrivateProtectedInSameUnit;
Procedure TestClass_PrivateInMainBeginFail;
Procedure TestClass_PrivateInDescendantFail;
@ -8596,7 +8597,7 @@ begin
'begin',
' w:=w+1;',
'end;',
'class procedure TRec.Create;',
'class procedure TRec.Create; static;',
'begin',
' w:=w+1;',
'end;',
@ -10513,6 +10514,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);

2
utils/fpcm/revision.inc
View File

@ -1 +1 @@
'2020-04-21 rev 44899'
'2020-04-21 rev 44920'