mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 23:19:24 +02:00
fcl-passrc: parser: local and anonymous records cannot be advanced, resolver: adv records: recordvalues, class methods must be static, sub class
git-svn-id: trunk@40795 -
This commit is contained in:
Mattias Gaertner
parent
d6891557d3
commit
5efbfcc2b0
@ -154,14 +154,14 @@ const
|
||||
nMethodHidesMethodOfBaseType = 3077;
|
||||
nContextExpectedXButFoundY = 3078;
|
||||
nContextXInvalidY = 3079;
|
||||
// free 3080;
|
||||
nIdentifierXIsNotAnInstanceField = 3080;
|
||||
nXIsNotSupported = 3081;
|
||||
nOperatorIsNotOverloadedAOpB = 3082;
|
||||
nIllegalQualifierAfter = 3084;
|
||||
nIllegalQualifierInFrontOf = 3085;
|
||||
nIllegalQualifierWithin = 3086;
|
||||
nMethodClassXInOtherUnitY = 3087;
|
||||
// free 3088
|
||||
nClassMethodsMustBeStaticInRecords = 3088;
|
||||
nCannotMixMethodResolutionAndDelegationAtX = 3089;
|
||||
nImplementsDoesNotSupportArrayProperty = 3101;
|
||||
nImplementsDoesNotSupportIndex = 3102;
|
||||
@ -277,6 +277,7 @@ resourcestring
|
||||
sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
|
||||
sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
|
||||
sContextXInvalidY = '%s: invalid %s';
|
||||
sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
|
||||
sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
|
||||
sXIsNotSupported = '%s is not supported';
|
||||
sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
|
||||
@ -285,6 +286,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';
|
||||
sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
|
||||
sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
|
||||
sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
|
||||
|
||||
@ -913,7 +913,7 @@ type
|
||||
DeclarationProc: TPasProcedure; // the corresponding forward declaration
|
||||
ImplProc: TPasProcedure; // the corresponding proc with Body
|
||||
OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
|
||||
ClassScope: TPasClassOrRecordScope;
|
||||
ClassOrRecordScope: TPasClassOrRecordScope;
|
||||
SelfArg: TPasArgument;
|
||||
Flags: TPasProcedureScopeFlags;
|
||||
BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
|
||||
@ -1860,7 +1860,7 @@ type
|
||||
function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
|
||||
function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
|
||||
PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
|
||||
function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
|
||||
function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
|
||||
// utility functions
|
||||
function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
|
||||
function GetElModeSwitches(El: TPasElement): TModeSwitches;
|
||||
@ -2975,7 +2975,7 @@ var
|
||||
begin
|
||||
Result:=inherited FindIdentifier(Identifier);
|
||||
if Result<>nil then exit;
|
||||
CurScope:=ClassScope;
|
||||
CurScope:=ClassOrRecordScope;
|
||||
if CurScope=nil then exit;
|
||||
repeat
|
||||
Result:=CurScope.FindIdentifier(Identifier);
|
||||
@ -3000,7 +3000,7 @@ var
|
||||
begin
|
||||
inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
|
||||
if Abort then exit;
|
||||
CurScope:=ClassScope;
|
||||
CurScope:=ClassOrRecordScope;
|
||||
if CurScope=nil then exit;
|
||||
repeat
|
||||
CurScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
|
||||
@ -3022,7 +3022,7 @@ var
|
||||
begin
|
||||
Result:=Self;
|
||||
repeat
|
||||
if Result.ClassScope<>nil then exit;
|
||||
if Result.ClassOrRecordScope<>nil then exit;
|
||||
Proc:=TPasProcedure(Element);
|
||||
if not (Proc.Parent is TProcedureBody) then exit(nil);
|
||||
Proc:=Proc.Parent.Parent as TPasProcedure;
|
||||
@ -3033,8 +3033,8 @@ end;
|
||||
procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
|
||||
begin
|
||||
inherited WriteIdentifiers(Prefix);
|
||||
if ClassScope<>nil then
|
||||
ClassScope.WriteIdentifiers(Prefix+'CS ');
|
||||
if ClassOrRecordScope<>nil then
|
||||
ClassOrRecordScope.WriteIdentifiers(Prefix+'CS ');
|
||||
end;
|
||||
|
||||
destructor TPasProcedureScope.Destroy;
|
||||
@ -5569,9 +5569,14 @@ 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.IsStatic then
|
||||
if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
|
||||
RaiseMsg(20181218195519,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'static'],Proc);
|
||||
if (Proc.ClassType=TPasClassProcedure)
|
||||
or (Proc.ClassType=TPasClassFunction)
|
||||
or (Proc.ClassType=TPasClassConstructor)
|
||||
or (Proc.ClassType=TPasClassDestructor) then
|
||||
begin
|
||||
if not Proc.IsStatic then
|
||||
RaiseMsg(20190106121503,nClassMethodsMustBeStaticInRecords,sClassMethodsMustBeStaticInRecords,[],Proc);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -5742,7 +5747,7 @@ begin
|
||||
// ToDo: store the scanner flags *before* it has parsed the token after the proc
|
||||
StoreScannerFlagsInProc(ProcScope);
|
||||
ClassOrRecScope:=Scopes[ScopeCount-2] as TPasClassOrRecordScope;
|
||||
ProcScope.ClassScope:=ClassOrRecScope;
|
||||
ProcScope.ClassOrRecordScope:=ClassOrRecScope;
|
||||
FindData:=Default(TFindOverloadProcData);
|
||||
FindData.Proc:=Proc;
|
||||
FindData.Args:=Proc.ProcType.Args;
|
||||
@ -5842,7 +5847,7 @@ begin
|
||||
|
||||
// search proc in class/record
|
||||
ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
|
||||
ClassOrRecScope:=ImplProcScope.ClassScope;
|
||||
ClassOrRecScope:=ImplProcScope.ClassOrRecordScope;
|
||||
if ClassOrRecScope=nil then
|
||||
RaiseInternalError(20161013172346);
|
||||
ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
|
||||
@ -5881,7 +5886,7 @@ begin
|
||||
or (DeclProc.ClassType=TPasClassProcedure)
|
||||
or (DeclProc.ClassType=TPasClassFunction) then
|
||||
begin
|
||||
if (not DeclProc.IsStatic) and (ClassOrRecScope is TPasClassScope) then
|
||||
if ClassOrRecScope is TPasClassScope then
|
||||
begin
|
||||
// 'Self' in a class proc is the hidden classtype argument
|
||||
SelfArg:=TPasArgument.Create('Self',DeclProc);
|
||||
@ -5891,7 +5896,9 @@ begin
|
||||
SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
|
||||
SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
|
||||
AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
|
||||
end;
|
||||
end
|
||||
else
|
||||
RaiseInternalError(20190106121745);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -6071,6 +6078,14 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExpectedClassAccessorStatic: boolean;
|
||||
begin
|
||||
if (ClassScope<>nil) and (proClassPropertyNonStatic in Options) then
|
||||
Result:=false
|
||||
else
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
|
||||
ProcArg: TPasArgument; ErrorEl: TPasElement);
|
||||
var
|
||||
@ -6476,7 +6491,7 @@ begin
|
||||
begin
|
||||
if Proc.ClassType<>TPasClassFunction then
|
||||
RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
|
||||
if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
|
||||
if Proc.IsStatic<>ExpectedClassAccessorStatic then
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
|
||||
else
|
||||
@ -6531,11 +6546,11 @@ begin
|
||||
begin
|
||||
if Proc.ClassType<>TPasClassProcedure then
|
||||
RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
|
||||
if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
|
||||
else
|
||||
RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
|
||||
if Proc.IsStatic<>ExpectedClassAccessorStatic then
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
|
||||
else
|
||||
RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -6617,12 +6632,22 @@ var
|
||||
DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
|
||||
AncestorClassEl: TPasClassType;
|
||||
|
||||
function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
|
||||
begin
|
||||
Result:=SameText(c.Name,DefAncestorName)
|
||||
and (c.Parent is TPasSection);
|
||||
end;
|
||||
|
||||
procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
|
||||
var
|
||||
CurEl: TPasElement;
|
||||
begin
|
||||
AncestorClassEl:=nil;
|
||||
if (CompareText(aClass.Name,DefAncestorName)=0) then exit;
|
||||
if SameText(aClass.Name,DefAncestorName) then
|
||||
begin
|
||||
if IsDefaultAncestor(aClass,DefAncestorName) then exit;
|
||||
RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
|
||||
end;
|
||||
CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false);
|
||||
if not (CurEl is TPasType) then
|
||||
RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
|
||||
@ -6715,7 +6740,7 @@ begin
|
||||
okClass:
|
||||
begin
|
||||
DefAncestorName:='TObject';
|
||||
if (CompareText(aClass.Name,DefAncestorName)=0) or aClass.IsExternal then
|
||||
if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
|
||||
begin
|
||||
// ok, no ancestor
|
||||
AncestorClassEl:=nil;
|
||||
@ -6736,7 +6761,7 @@ begin
|
||||
DefAncestorName:='IInterface'
|
||||
else
|
||||
DefAncestorName:='IUnknown';
|
||||
if SameText(DefAncestorName,aClass.Name) then
|
||||
if IsDefaultAncestor(aClass,DefAncestorName) then
|
||||
AncestorClassEl:=nil
|
||||
else
|
||||
begin
|
||||
@ -8128,7 +8153,7 @@ begin
|
||||
SelfScope:=ProcScope.GetSelfScope;
|
||||
if SelfScope=nil then
|
||||
RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
|
||||
ClassRecScope:=SelfScope.ClassScope;
|
||||
ClassRecScope:=SelfScope.ClassOrRecordScope;
|
||||
|
||||
AncestorScope:=nil;
|
||||
if ClassRecScope is TPasClassScope then
|
||||
@ -8183,7 +8208,7 @@ begin
|
||||
SelfScope:=ProcScope.GetSelfScope;
|
||||
if SelfScope=nil then
|
||||
RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
|
||||
ClassRecScope:=SelfScope.ClassScope;
|
||||
ClassRecScope:=SelfScope.ClassOrRecordScope;
|
||||
|
||||
AncestorScope:=nil;
|
||||
if ClassRecScope is TPasClassScope then
|
||||
@ -8895,7 +8920,7 @@ procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
|
||||
if SameText(Result.Name,aName) then
|
||||
exit;
|
||||
end;
|
||||
if (RecType.VariantEl is TPasVariable) then
|
||||
if RecType.VariantEl is TPasVariable then
|
||||
begin
|
||||
Result:=TPasVariable(RecType.VariantEl);
|
||||
if SameText(Result.Name,aName) then
|
||||
@ -8938,9 +8963,12 @@ begin
|
||||
Member:=GetMember(RecType,Field^.Name);
|
||||
if Member=nil then
|
||||
RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
|
||||
if not (Member is TPasVariable) then
|
||||
RaiseMsg(20180429121933,nVariableIdentifierExpected,sVariableIdentifierExpected,
|
||||
if Member.ClassType<>TPasVariable then
|
||||
RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
|
||||
[],Field^.ValueExp);
|
||||
if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
|
||||
RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
|
||||
['record assignment'],Field^.ValueExp);
|
||||
CreateReference(Member,Field^.NameExp,rraAssign);
|
||||
// check duplicates
|
||||
for j:=0 to i-1 do
|
||||
@ -8957,7 +8985,9 @@ begin
|
||||
for i:=0 to RecType.Members.Count-1 do
|
||||
begin
|
||||
Member:=TPasElement(RecType.Members[i]);
|
||||
if not (Member is TPasVariable) then continue;
|
||||
if Member.ClassType<>TPasVariable then continue;
|
||||
if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
|
||||
continue;
|
||||
j:=length(El.Fields)-1;
|
||||
while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
|
||||
dec(j);
|
||||
@ -9232,7 +9262,7 @@ var
|
||||
i: Integer;
|
||||
DeclEl: TPasElement;
|
||||
Proc: TPasProcedure;
|
||||
aClassType: TPasClassType;
|
||||
aClassOrRec: TPasMembersType;
|
||||
begin
|
||||
if IsElementSkipped(El) then exit;
|
||||
if El is TPasDeclarations then
|
||||
@ -9250,13 +9280,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if El.ClassType=TPasClassType then
|
||||
else if El is TPasMembersType then
|
||||
begin
|
||||
aClassType:=TPasClassType(El);
|
||||
if aClassType.ObjKind in [okInterface,okDispInterface] then exit;
|
||||
for i:=0 to aClassType.Members.Count-1 do
|
||||
aClassOrRec:=TPasMembersType(El);
|
||||
if (aClassOrRec is TPasClassType)
|
||||
and (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface])
|
||||
then exit;
|
||||
for i:=0 to aClassOrRec.Members.Count-1 do
|
||||
begin
|
||||
DeclEl:=TPasElement(aClassType.Members[i]);
|
||||
DeclEl:=TPasElement(aClassOrRec.Members[i]);
|
||||
if DeclEl is TPasProcedure then
|
||||
begin
|
||||
Proc:=TPasProcedure(DeclEl);
|
||||
@ -9660,7 +9692,7 @@ begin
|
||||
RaiseNotYetImplemented(20161013170956,El);
|
||||
|
||||
ProcScope.VisibilityContext:=ClassOrRecType;
|
||||
ProcScope.ClassScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
|
||||
ProcScope.ClassOrRecordScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
|
||||
end;// HasDot=true
|
||||
end;
|
||||
|
||||
@ -15084,7 +15116,7 @@ begin
|
||||
and (TPasWithExprScope(StartScope).Scope is TPasClassOrRecordScope) then
|
||||
ClassRecScope:=TPasClassOrRecordScope(TPasWithExprScope(StartScope).Scope)
|
||||
else if (StartScope is TPasProcedureScope) then
|
||||
ClassRecScope:=TPasProcedureScope(StartScope).ClassScope
|
||||
ClassRecScope:=TPasProcedureScope(StartScope).ClassOrRecordScope
|
||||
else
|
||||
RaiseInternalError(20170131150855,GetObjName(StartScope));
|
||||
TypeEl:=ClassRecScope.Element as TPasType;
|
||||
@ -18271,7 +18303,7 @@ begin
|
||||
exit(NotLocked(IdentEl));
|
||||
end;
|
||||
|
||||
function TPasResolver.ResolvedElIsClassInstance(
|
||||
function TPasResolver.ResolvedElIsClassOrRecordInstance(
|
||||
const ResolvedEl: TPasResolverResult): boolean;
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
@ -18280,8 +18312,13 @@ begin
|
||||
if ResolvedEl.BaseType<>btContext then exit;
|
||||
TypeEl:=ResolvedEl.LoTypeEl;
|
||||
if TypeEl=nil then exit;
|
||||
if TypeEl.ClassType<>TPasClassType then exit;
|
||||
if TPasClassType(TypeEl).ObjKind<>okClass then exit;
|
||||
if TypeEl.ClassType=TPasClassType then
|
||||
begin
|
||||
if TPasClassType(TypeEl).ObjKind<>okClass then exit;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasRecordType then
|
||||
else
|
||||
exit;
|
||||
if (ResolvedEl.IdentEl is TPasVariable)
|
||||
or (ResolvedEl.IdentEl.ClassType=TPasArgument)
|
||||
or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
|
||||
|
||||
@ -3557,7 +3557,9 @@ begin
|
||||
RecordEl.SetGenericTemplates(List);
|
||||
NextToken;
|
||||
ParseRecordFieldList(RecordEl,tkend,
|
||||
msAdvancedRecords in Scanner.CurrentModeSwitches);
|
||||
(msAdvancedRecords in Scanner.CurrentModeSwitches)
|
||||
and not (Declarations is TProcedureBody)
|
||||
and (RecordEl.Name<>''));
|
||||
CheckHint(RecordEl,True);
|
||||
Engine.FinishScope(stTypeDef,RecordEl);
|
||||
end;
|
||||
@ -6344,7 +6346,15 @@ begin
|
||||
tkClass:
|
||||
begin
|
||||
if Not AllowMethods then
|
||||
ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
|
||||
begin
|
||||
NextToken;
|
||||
case CurToken of
|
||||
tkConst: ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
|
||||
tkvar: ParseExc(nErrRecordVariablesNotAllowed,SErrRecordVariablesNotAllowed);
|
||||
else
|
||||
ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
|
||||
end;
|
||||
end;
|
||||
if isClass then
|
||||
ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
|
||||
isClass:=True;
|
||||
@ -6437,7 +6447,8 @@ begin
|
||||
try
|
||||
Result.PackMode:=PackMode;
|
||||
NextToken;
|
||||
ParseRecordFieldList(Result,tkEnd,msAdvancedRecords in Scanner.CurrentModeSwitches);
|
||||
ParseRecordFieldList(Result,tkEnd,
|
||||
(msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
|
||||
Engine.FinishScope(stTypeDef,Result);
|
||||
ok:=true;
|
||||
finally
|
||||
|
||||
@ -490,7 +490,10 @@ type
|
||||
Procedure TestAdvRecord;
|
||||
Procedure TestAdvRecord_Private;
|
||||
Procedure TestAdvRecord_StrictPrivate;
|
||||
Procedure TestAdvRecord_MethodImplMissingFail;
|
||||
Procedure TestAdvRecord_VarConst;
|
||||
Procedure TestAdvRecord_RecVal_ConstFail;
|
||||
Procedure TestAdvRecord_RecVal_ClassVarFail;
|
||||
Procedure TestAdvRecord_LocalForwardType;
|
||||
Procedure TestAdvRecord_Constructor_NewInstance;
|
||||
Procedure TestAdvRecord_ConstructorNoParamsFail;
|
||||
@ -504,6 +507,8 @@ type
|
||||
Procedure TestAdvRecord_RecordAsFuncResult;
|
||||
Procedure TestAdvRecord_InheritedFail;
|
||||
Procedure TestAdvRecord_ForInEnumerator;
|
||||
Procedure TestAdvRecord_InFunctionFail;
|
||||
Procedure TestAdvRecord_SubClass;
|
||||
|
||||
// class
|
||||
Procedure TestClass;
|
||||
@ -7874,6 +7879,20 @@ begin
|
||||
CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_MethodImplMissingFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' procedure SetSize(Value: word);',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_VarConst;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -7913,6 +7932,42 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_RecVal_ConstFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' V1: word;',
|
||||
' const',
|
||||
' C1 = 3;',
|
||||
' end;',
|
||||
'var',
|
||||
' r: TRec = (V1:2; C1: 4);',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_RecVal_ClassVarFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' V1: word;',
|
||||
' class var',
|
||||
' C1: word;',
|
||||
' end;',
|
||||
'var',
|
||||
' r: TRec = (V1:2; C1: 4);',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_LocalForwardType;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -7947,7 +8002,7 @@ begin
|
||||
'type',
|
||||
' TRec = record',
|
||||
' constructor Create(w: word);',
|
||||
' class function DoSome: TRec;',
|
||||
' class function DoSome: TRec; static;',
|
||||
' end;',
|
||||
'constructor TRec.Create(w: word);',
|
||||
'begin',
|
||||
@ -8027,14 +8082,17 @@ begin
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' class procedure {#a}Create;',
|
||||
' class constructor Create;',
|
||||
' class var w: word;',
|
||||
' class procedure {#a}Create; static;',
|
||||
' class constructor Create; static;',
|
||||
' end;',
|
||||
'class constructor TRec.Create;',
|
||||
'begin',
|
||||
' w:=w+1;',
|
||||
'end;',
|
||||
'class procedure TRec.Create;',
|
||||
'begin',
|
||||
' w:=w+1;',
|
||||
'end;',
|
||||
'begin',
|
||||
' TRec.{@a}Create;',
|
||||
@ -8231,8 +8289,8 @@ begin
|
||||
'type',
|
||||
' {#A}TRec = record',
|
||||
' {#A_i}i: longint;',
|
||||
' class function {#A_CreateA}Create: TRec;',
|
||||
' class function {#A_CreateB}Create(i: longint): TRec;',
|
||||
' class function {#A_CreateA}Create: TRec; static;',
|
||||
' class function {#A_CreateB}Create(i: longint): TRec; static;',
|
||||
' end;',
|
||||
'function {#F}F: TRec;',
|
||||
'begin',
|
||||
@ -8313,6 +8371,53 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_InFunctionFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'procedure DoIt;',
|
||||
'type',
|
||||
' TBird = record',
|
||||
' class var i: word;',
|
||||
' end;',
|
||||
'var',
|
||||
' b: TBird;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckParserException(sErrRecordVariablesNotAllowed,nErrRecordVariablesNotAllowed);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_SubClass;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch AdvancedRecords}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TPoint = record',
|
||||
' type',
|
||||
' TBird = class',
|
||||
' procedure DoIt;',
|
||||
' class procedure Glob;',
|
||||
' end;',
|
||||
' procedure DoIt(b: TBird);',
|
||||
' end;',
|
||||
'procedure TPoint.TBird.DoIt;',
|
||||
'begin',
|
||||
'end;',
|
||||
'class procedure TPoint.TBird.Glob;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure TPoint.DoIt(b: TBird);',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user