mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 11:09:19 +02:00
fcl-passrc: parse class helper class var, resolver: check helper ancestor
git-svn-id: trunk@40881 -
This commit is contained in:
parent
13793e9354
commit
ccdc0ce767
@ -176,7 +176,8 @@ const
|
|||||||
nCantAssignValuesToConstVariable = 3110;
|
nCantAssignValuesToConstVariable = 3110;
|
||||||
nIllegalAssignmentToForLoopVar = 3111;
|
nIllegalAssignmentToForLoopVar = 3111;
|
||||||
nFunctionHidesIdentifier_NonProc = 3112;
|
nFunctionHidesIdentifier_NonProc = 3112;
|
||||||
// Note: use one of the free IDs above
|
nTypeXCannotBeExtendedByATypeHelper = 3113;
|
||||||
|
nDerivedXMustExtendASubClassY = 3114;
|
||||||
|
|
||||||
// using same IDs as FPC
|
// using same IDs as FPC
|
||||||
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
||||||
@ -300,6 +301,8 @@ resourcestring
|
|||||||
sMissingFieldsX = 'Missing fields: "%s"';
|
sMissingFieldsX = 'Missing fields: "%s"';
|
||||||
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';
|
||||||
|
sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
|
||||||
|
|
||||||
type
|
type
|
||||||
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
||||||
|
@ -50,6 +50,15 @@ Works:
|
|||||||
- const param makes children const too
|
- const param makes children const too
|
||||||
- const TRecordValues
|
- const TRecordValues
|
||||||
- function default(record type): record
|
- function default(record type): record
|
||||||
|
- advanced records:
|
||||||
|
- $modeswitch AdvancedRecords
|
||||||
|
- visibility public, private, strict private
|
||||||
|
- sub type
|
||||||
|
- const, var, class var
|
||||||
|
- function/procedure/class function/class procedure
|
||||||
|
- property, class property, default property
|
||||||
|
- constructor
|
||||||
|
- RTTI
|
||||||
- class:
|
- class:
|
||||||
- forward declaration
|
- forward declaration
|
||||||
- instance.a
|
- instance.a
|
||||||
@ -224,15 +233,7 @@ ToDo:
|
|||||||
- operator overload
|
- operator overload
|
||||||
- operator enumerator
|
- operator enumerator
|
||||||
- binaryexpr
|
- binaryexpr
|
||||||
- advanced records:
|
- advanced records
|
||||||
- $modeswitch AdvancedRecords
|
|
||||||
- sub type
|
|
||||||
- const
|
|
||||||
- var
|
|
||||||
- function/procedure/class function/class procedure
|
|
||||||
- property, class property
|
|
||||||
- RTTI
|
|
||||||
- operator overloading
|
|
||||||
- Include/Exclude for set of int/char/bool
|
- Include/Exclude for set of int/char/bool
|
||||||
- error if property method resolution is not used
|
- error if property method resolution is not used
|
||||||
- $H-hintpos$H+
|
- $H-hintpos$H+
|
||||||
@ -5565,6 +5566,21 @@ begin
|
|||||||
if Proc.IsOverride then
|
if Proc.IsOverride then
|
||||||
RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
|
RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
|
||||||
end;
|
end;
|
||||||
|
okClassHelper,okRecordHelper,okTypeHelper:
|
||||||
|
if msDelphi in CurrentParser.CurrentModeswitches then
|
||||||
|
begin
|
||||||
|
if Proc.IsAbstract then
|
||||||
|
RaiseMsg(20190116215744,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'abstract'],Proc);
|
||||||
|
if Proc.IsVirtual and (ObjKind=okRecordHelper) then
|
||||||
|
RaiseMsg(20190116221659,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if Proc.IsVirtual then
|
||||||
|
RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
|
||||||
|
if Proc.IsOverride then
|
||||||
|
RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
if Proc.IsAbstract then
|
if Proc.IsAbstract then
|
||||||
begin
|
begin
|
||||||
@ -6698,7 +6714,7 @@ var
|
|||||||
CanonicalSelf: TPasClassOfType;
|
CanonicalSelf: TPasClassOfType;
|
||||||
Decl: TPasElement;
|
Decl: TPasElement;
|
||||||
j: integer;
|
j: integer;
|
||||||
IntfType, IntfTypeRes: TPasType;
|
IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
|
||||||
ResIntfList, Members: TFPList;
|
ResIntfList, Members: TFPList;
|
||||||
begin
|
begin
|
||||||
if aClass.IsForward then
|
if aClass.IsForward then
|
||||||
@ -6742,6 +6758,73 @@ begin
|
|||||||
RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
|
RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
|
||||||
[CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
|
[CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
|
||||||
end;
|
end;
|
||||||
|
okClassHelper,okRecordHelper,okTypeHelper:
|
||||||
|
begin
|
||||||
|
if aClass.IsExternal then
|
||||||
|
RaiseMsg(20190116192722,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
|
||||||
|
HelperForType:=ResolveAliasType(aClass.HelperForType);
|
||||||
|
case aClass.ObjKind of
|
||||||
|
okClassHelper:
|
||||||
|
begin
|
||||||
|
if not (HelperForType is TPasClassType) then
|
||||||
|
RaiseXExpectedButYFound(20190116194751,'class type',GetTypeDescription(aClass.HelperForType),aClass);
|
||||||
|
if TPasClassType(HelperForType).ObjKind<>okClass then
|
||||||
|
RaiseXExpectedButYFound(20190116194855,'class type',GetTypeDescription(aClass.HelperForType),aClass);
|
||||||
|
if TPasClassType(HelperForType).IsForward then
|
||||||
|
RaiseMsg(20190116194931,nTypeXIsNotYetCompletelyDefined,
|
||||||
|
sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
|
||||||
|
end;
|
||||||
|
okRecordHelper:
|
||||||
|
if msDelphi in CurrentParser.CurrentModeswitches then
|
||||||
|
begin
|
||||||
|
if (HelperForType.ClassType=TPasRecordType)
|
||||||
|
or (HelperForType.ClassType=TPasArrayType)
|
||||||
|
or (HelperForType.ClassType=TPasSetType)
|
||||||
|
or (HelperForType.ClassType=TPasEnumType)
|
||||||
|
or (HelperForType.ClassType=TPasRangeType)
|
||||||
|
then
|
||||||
|
// ok
|
||||||
|
else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
|
||||||
|
and (HelperForType.CustomData is TResElDataBaseType)) then
|
||||||
|
else
|
||||||
|
RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
|
||||||
|
sTypeXCannotBeExtendedByATypeHelper,[aClass.HelperForType.Name],aClass);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// mode objfpc
|
||||||
|
if (HelperForType.ClassType=TPasRecordType) then
|
||||||
|
else
|
||||||
|
RaiseMsg(20190116200519,nTypeXCannotBeExtendedByATypeHelper,
|
||||||
|
sTypeXCannotBeExtendedByATypeHelper,[aClass.HelperForType.Name],aClass);
|
||||||
|
end;
|
||||||
|
okTypeHelper:
|
||||||
|
begin
|
||||||
|
if HelperForType.ClassType=TPasUnresolvedSymbolRef then
|
||||||
|
begin
|
||||||
|
if (HelperForType.ClassType=TPasRecordType)
|
||||||
|
or (HelperForType.ClassType=TPasArrayType)
|
||||||
|
or (HelperForType.ClassType=TPasSetType)
|
||||||
|
or (HelperForType.ClassType=TPasEnumType)
|
||||||
|
or (HelperForType.ClassType=TPasRangeType)
|
||||||
|
then
|
||||||
|
// ok
|
||||||
|
else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
|
||||||
|
and (HelperForType.CustomData is TResElDataBaseType)) then
|
||||||
|
else if (HelperForType.ClassType=TPasClassType)
|
||||||
|
and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
|
||||||
|
begin
|
||||||
|
if TPasClassType(HelperForType).IsForward then
|
||||||
|
RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
|
||||||
|
sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
|
||||||
|
sTypeXCannotBeExtendedByATypeHelper,[aClass.HelperForType.Name],aClass);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
|
RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
|
||||||
end;
|
end;
|
||||||
@ -6804,6 +6887,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
okClassHelper,okRecordHelper,okTypeHelper: ; // no root ancestor
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else if AncestorType.ClassType<>TPasClassType then
|
else if AncestorType.ClassType<>TPasClassType then
|
||||||
@ -6814,18 +6898,29 @@ begin
|
|||||||
begin
|
begin
|
||||||
AncestorClassEl:=TPasClassType(AncestorType);
|
AncestorClassEl:=TPasClassType(AncestorType);
|
||||||
if AncestorClassEl.ObjKind<>aClass.ObjKind then
|
if AncestorClassEl.ObjKind<>aClass.ObjKind then
|
||||||
begin
|
|
||||||
RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
|
RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
|
||||||
GetElementTypeName(AncestorClassEl)+' type',aClass);
|
GetElementTypeName(AncestorClassEl)+' type',aClass);
|
||||||
end
|
if aClass.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
|
||||||
else
|
begin
|
||||||
EmitTypeHints(aClass,AncestorClassEl);
|
HelperForType:=ResolveAliasType(aClass.HelperForType);
|
||||||
|
AncestorHelperFor:=ResolveAliasType(AncestorClassEl.HelperForType);
|
||||||
|
if IsSameType(HelperForType,AncestorHelperFor,prraNone) then
|
||||||
|
// helper for same type as ancestor helper -> ok
|
||||||
|
else if (HelperForType is TPasClassType)
|
||||||
|
and (AncestorHelperFor is TPasClassType)
|
||||||
|
and (CheckClassIsClass(HelperForType,AncestorHelperFor,aClass)<>cIncompatible) then
|
||||||
|
// helper is for descendant class of ancestor helper for -> ok
|
||||||
|
else
|
||||||
|
RaiseMsg(20190116203931,nDerivedXMustExtendASubClassY,sDerivedXMustExtendASubClassY,
|
||||||
|
[GetElementTypeName(aClass),AncestorClassEl.HelperForType.Name],aClass);
|
||||||
|
end;
|
||||||
|
EmitTypeHints(aClass,AncestorClassEl);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
AncestorClassScope:=nil;
|
AncestorClassScope:=nil;
|
||||||
if AncestorClassEl=nil then
|
if AncestorClassEl=nil then
|
||||||
begin
|
begin
|
||||||
// root class e.g. TObject, IUnknown
|
// root class e.g. TObject, IUnknown, helper
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
@ -136,7 +136,7 @@ resourcestring
|
|||||||
SLogStartImplementation = 'Start parsing implementation section.';
|
SLogStartImplementation = 'Start parsing implementation section.';
|
||||||
SLogStartInterface = 'Start parsing interface section';
|
SLogStartInterface = 'Start parsing interface section';
|
||||||
SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
|
SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
|
||||||
SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
|
SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
|
||||||
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
|
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
|
||||||
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
|
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
|
||||||
SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
|
SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
|
||||||
@ -1247,6 +1247,7 @@ begin
|
|||||||
if not (PM in [pmOverload, pmMessage,
|
if not (PM in [pmOverload, pmMessage,
|
||||||
pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
|
pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
|
||||||
end;
|
end;
|
||||||
|
exit;
|
||||||
end
|
end
|
||||||
else if Parent is TPasRecordType then
|
else if Parent is TPasRecordType then
|
||||||
begin
|
begin
|
||||||
@ -1254,6 +1255,7 @@ begin
|
|||||||
pmInline, pmAssembler,
|
pmInline, pmAssembler,
|
||||||
pmExternal,
|
pmExternal,
|
||||||
pmNoReturn, pmFar, pmFinal]) then exit(false);
|
pmNoReturn, pmFar, pmFinal]) then exit(false);
|
||||||
|
exit;
|
||||||
end;
|
end;
|
||||||
Parent:=Parent.Parent;
|
Parent:=Parent.Parent;
|
||||||
end;
|
end;
|
||||||
@ -6690,6 +6692,7 @@ begin
|
|||||||
LastToken:=CurToken;
|
LastToken:=CurToken;
|
||||||
while (CurToken<>tkEnd) do
|
while (CurToken<>tkEnd) do
|
||||||
begin
|
begin
|
||||||
|
//writeln('TPasParser.ParseClassMembers LastToken=',LastToken,' CurToken=',CurToken,' haveClass=',haveClass,' CurSection=',CurSection);
|
||||||
case CurToken of
|
case CurToken of
|
||||||
tkType:
|
tkType:
|
||||||
begin
|
begin
|
||||||
@ -6715,18 +6718,18 @@ begin
|
|||||||
CurSection:=stConst;
|
CurSection:=stConst;
|
||||||
end;
|
end;
|
||||||
tkVar:
|
tkVar:
|
||||||
begin
|
if not (CurSection in [stVar,stClassVar]) then
|
||||||
case AType.ObjKind of
|
begin
|
||||||
okClass,okObject,okGeneric,
|
if (AType.ObjKind in [okClass,okObject,okGeneric])
|
||||||
okClassHelper,okRecordHelper,okTypeHelper: ;
|
or (haveClass and (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper])) then
|
||||||
else
|
// ok
|
||||||
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
|
else
|
||||||
end;
|
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
|
||||||
if LastToken=tkClass then
|
if LastToken=tkClass then
|
||||||
CurSection:=stClassVar
|
CurSection:=stClassVar
|
||||||
else
|
else
|
||||||
CurSection:=stVar;
|
CurSection:=stVar;
|
||||||
end;
|
end;
|
||||||
tkIdentifier:
|
tkIdentifier:
|
||||||
if CheckVisibility(CurtokenString,CurVisibility) then
|
if CheckVisibility(CurtokenString,CurVisibility) then
|
||||||
CurSection:=stNone
|
CurSection:=stNone
|
||||||
@ -6740,11 +6743,17 @@ begin
|
|||||||
stConst :
|
stConst :
|
||||||
ParseMembersLocalConsts(AType,CurVisibility);
|
ParseMembersLocalConsts(AType,CurVisibility);
|
||||||
stNone,
|
stNone,
|
||||||
stVar,
|
stVar:
|
||||||
|
begin
|
||||||
|
if not (AType.ObjKind in [okObject,okClass,okGeneric]) then
|
||||||
|
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
|
||||||
|
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
|
||||||
|
HaveClass:=False;
|
||||||
|
end;
|
||||||
stClassVar:
|
stClassVar:
|
||||||
begin
|
begin
|
||||||
if (AType.ObjKind in [okInterface,okDispInterface]) then
|
if not (AType.ObjKind in [okObject,okClass,okGeneric,okClassHelper,okRecordHelper,okTypeHelper]) then
|
||||||
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
|
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
|
||||||
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
|
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
|
||||||
HaveClass:=False;
|
HaveClass:=False;
|
||||||
end;
|
end;
|
||||||
@ -6757,7 +6766,11 @@ begin
|
|||||||
curSection:=stNone;
|
curSection:=stNone;
|
||||||
if not haveClass then
|
if not haveClass then
|
||||||
SaveComments;
|
SaveComments;
|
||||||
if AType.ObjKind in [okInterface,okDispInterface,okRecordHelper] then
|
if (AType.ObjKind in [okObject,okClass,okGeneric])
|
||||||
|
or ((CurToken=tkconstructor)
|
||||||
|
and (AType.ObjKind in [okClassHelper,okTypeHelper,okRecordHelper])) then
|
||||||
|
// ok
|
||||||
|
else
|
||||||
ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
|
ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
|
||||||
ProcessMethod(AType,HaveClass,CurVisibility);
|
ProcessMethod(AType,HaveClass,CurVisibility);
|
||||||
haveClass:=False;
|
haveClass:=False;
|
||||||
|
@ -860,6 +860,16 @@ type
|
|||||||
Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
|
Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
|
||||||
Procedure TestHint_Garbage;
|
Procedure TestHint_Garbage;
|
||||||
|
|
||||||
|
// helpers
|
||||||
|
Procedure ClassHelper;
|
||||||
|
Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
|
||||||
|
Procedure ClassHelper_ForInterfaceFail;
|
||||||
|
Procedure ClassHelper_FieldFail;
|
||||||
|
Procedure ClassHelper_AbstractFail;
|
||||||
|
Procedure ClassHelper_VirtualObjFPCFail;
|
||||||
|
Procedure RecordHelper;
|
||||||
|
Procedure TypeHelper;
|
||||||
|
|
||||||
// attributes
|
// attributes
|
||||||
Procedure TestAttributes_Ignore;
|
Procedure TestAttributes_Ignore;
|
||||||
end;
|
end;
|
||||||
@ -12148,7 +12158,7 @@ begin
|
|||||||
' i: longint;',
|
' i: longint;',
|
||||||
' end;',
|
' end;',
|
||||||
'begin']);
|
'begin']);
|
||||||
CheckParserException(SParserNoFieldsAllowed,nParserNoFieldsAllowed);
|
CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestResolver.TestClassInterfaceConstFail;
|
procedure TTestResolver.TestClassInterfaceConstFail;
|
||||||
@ -12249,7 +12259,7 @@ begin
|
|||||||
' procedure DoIt; virtual;',
|
' procedure DoIt; virtual;',
|
||||||
' end;',
|
' end;',
|
||||||
'begin']);
|
'begin']);
|
||||||
CheckParserException(sParserNoFieldsAllowed,nParserNoFieldsAllowed);
|
CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestResolver.TestClassInterface_Overloads;
|
procedure TTestResolver.TestClassInterface_Overloads;
|
||||||
@ -15486,6 +15496,162 @@ begin
|
|||||||
CheckResolverUnexpectedHints(true);
|
CheckResolverUnexpectedHints(true);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'type',
|
||||||
|
' TObject = class',
|
||||||
|
' end;',
|
||||||
|
' TObjectHelper = class helper for TObject',
|
||||||
|
' type T = word;',
|
||||||
|
' const',
|
||||||
|
' c: T = 3;',
|
||||||
|
' k: T = 4;',
|
||||||
|
' class var',
|
||||||
|
' v: T;',
|
||||||
|
' w: T;',
|
||||||
|
' end;',
|
||||||
|
' TBird = class(TObject)',
|
||||||
|
' end;',
|
||||||
|
' TBirdHelper = class helper for TBird',
|
||||||
|
' end;',
|
||||||
|
' TExtObjHelper = class helper(TObjectHelper) for TBird',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseProgram;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper_AncestorIsNotHelperForDescendantFail;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'type',
|
||||||
|
' TObject = class',
|
||||||
|
' end;',
|
||||||
|
' TBird = class(TObject)',
|
||||||
|
' end;',
|
||||||
|
' TBirdHelper = class helper for TBird',
|
||||||
|
' end;',
|
||||||
|
' TFish = class(TObject)',
|
||||||
|
' end;',
|
||||||
|
' THelper = class helper(TBirdHelper) for TFish',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('Derived class helper must extend a subclass of "TBird" or the class itself',
|
||||||
|
nDerivedXMustExtendASubClassY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper_ForInterfaceFail;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'type',
|
||||||
|
' IUnknown = interface',
|
||||||
|
' procedure DoIt;',
|
||||||
|
' end;',
|
||||||
|
' TBirdHelper = class helper for IUnknown',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('class type expected, but IUnknown found',
|
||||||
|
nXExpectedButYFound);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper_FieldFail;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'type',
|
||||||
|
' TObject = class',
|
||||||
|
' end;',
|
||||||
|
' TObjHelper = class helper for TObject',
|
||||||
|
' F: word;',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckParserException('Fields are not allowed in class helper',
|
||||||
|
nParserNoFieldsAllowed);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper_AbstractFail;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'{$mode delphi}',
|
||||||
|
'type',
|
||||||
|
' TObject = class',
|
||||||
|
' end;',
|
||||||
|
' TObjHelper = class helper for TObject',
|
||||||
|
' procedure DoIt; virtual; abstract;',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('Invalid class helper procedure modifier abstract',
|
||||||
|
nInvalidXModifierY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.ClassHelper_VirtualObjFPCFail;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'type',
|
||||||
|
' TObject = class',
|
||||||
|
' end;',
|
||||||
|
' TObjHelper = class helper for TObject',
|
||||||
|
' procedure DoIt; virtual;',
|
||||||
|
' end;',
|
||||||
|
'procedure TObjHelper.DoIt;',
|
||||||
|
'begin end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('Invalid class helper procedure modifier virtual',
|
||||||
|
nInvalidXModifierY);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.RecordHelper;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'{$mode delphi}',
|
||||||
|
'type',
|
||||||
|
' TRec = record',
|
||||||
|
' end;',
|
||||||
|
' TRecHelper = record helper for TRec',
|
||||||
|
' type T = word;',
|
||||||
|
' const',
|
||||||
|
' c: T = 3;',
|
||||||
|
' k: T = 4;',
|
||||||
|
' class var',
|
||||||
|
' v: T;',
|
||||||
|
' w: T;',
|
||||||
|
' end;',
|
||||||
|
' TAnt = word;',
|
||||||
|
' TAntHelper = record helper for TAnt',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseProgram;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TypeHelper;
|
||||||
|
begin
|
||||||
|
StartProgram(false);
|
||||||
|
Add([
|
||||||
|
'{$modeswitch typehelpers}',
|
||||||
|
'type',
|
||||||
|
' TStringHelper = type helper for string',
|
||||||
|
' end;',
|
||||||
|
' TCaption = string;',
|
||||||
|
' TCapHelper = type helper(TStringHelper) for TCaption',
|
||||||
|
' end;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseProgram;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestResolver.TestAttributes_Ignore;
|
procedure TTestResolver.TestAttributes_Ignore;
|
||||||
begin
|
begin
|
||||||
StartProgram(false);
|
StartProgram(false);
|
||||||
|
Loading…
Reference in New Issue
Block a user