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

fcl-passrc: resolver: error on record helper for byte in mode objfpc

Browse Source 
git-svn-id: trunk@41272 -
This commit is contained in:
Mattias Gaertner 2019-02-10 00:22:18 +00:00
parent 3779d69075
commit cb1a53c680
3 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -177,11 +177,12 @@ const
nIllegalAssignmentToForLoopVar = 3111; nIllegalAssignmentToForLoopVar = 3111;
nFunctionHidesIdentifier_NonProc = 3112; nFunctionHidesIdentifier_NonProc = 3112;
nTypeXCannotBeExtendedByATypeHelper = 3113; nTypeXCannotBeExtendedByATypeHelper = 3113;
nDerivedXMustExtendASubClassY = 3114; nTypeXCannotBeExtendedByARecordHelper = 3114;
nDefaultPropertyNotAllowedInHelperForX = 3115; nDerivedXMustExtendASubClassY = 3115;
nHelpersCannotBeUsedAsTypes = 3116; nDefaultPropertyNotAllowedInHelperForX = 3116;
nBitWiseOperationsAre32Bit = 3117; nHelpersCannotBeUsedAsTypes = 3117;
nImplictConversionUnicodeToAnsi = 3118; nBitWiseOperationsAre32Bit = 3118;
nImplictConversionUnicodeToAnsi = 3119;
// using same IDs as FPC // using same IDs as FPC
nVirtualMethodXHasLowerVisibility = 3250; // was 3050 nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@ -306,6 +307,7 @@ resourcestring
sCantAssignValuesToConstVariable = 'Can''t assign values to const variable'; sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"'; sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper'; sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
sTypeXCannotBeExtendedByARecordHelper = 'Type "%s" cannot be extended by a record helper';
sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself'; sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s'; sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types'; sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';

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

@ -7158,16 +7158,16 @@ begin
else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef) else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
and (HelperForType.CustomData is TResElDataBaseType)) then and (HelperForType.CustomData is TResElDataBaseType)) then
else else
RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper, RaiseMsg(20190116200304,nTypeXCannotBeExtendedByARecordHelper,
sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass); sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
end end
else else
begin begin
// mode objfpc // mode objfpc
if (HelperForType.ClassType=TPasRecordType) then if (HelperForType.ClassType=TPasRecordType) then
else else
RaiseMsg(20190116200519,nTypeXCannotBeExtendedByATypeHelper, RaiseMsg(20190116200519,nTypeXCannotBeExtendedByARecordHelper,
sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass); sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
end; end;
okTypeHelper: okTypeHelper:
begin begin

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

@ -904,6 +904,7 @@ type
Procedure TestClassHelper_DefaultClassProperty; Procedure TestClassHelper_DefaultClassProperty;
Procedure TestClassHelper_MultipleScopeHelpers; Procedure TestClassHelper_MultipleScopeHelpers;
Procedure TestRecordHelper; Procedure TestRecordHelper;
Procedure TestRecordHelper_ForByteFail;
Procedure TestRecordHelper_ClassNonStaticFail; Procedure TestRecordHelper_ClassNonStaticFail;
Procedure TestRecordHelper_InheritedObjFPC; Procedure TestRecordHelper_InheritedObjFPC;
Procedure TestRecordHelper_Constructor_NewInstance; Procedure TestRecordHelper_Constructor_NewInstance;
@ -16751,6 +16752,20 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestRecordHelper_ForByteFail;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TRecHelper = record helper for byte',
' class var Glob: word;',
' end;',
'begin',
'']);
CheckResolverException('Type "Byte" cannot be extended by a record helper',nTypeXCannotBeExtendedByARecordHelper);
end;
procedure TTestResolver.TestRecordHelper_ClassNonStaticFail; procedure TTestResolver.TestRecordHelper_ClassNonStaticFail;
begin begin
StartProgram(false); StartProgram(false);