mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 16:40:28 +02:00
fcl-passrc: parse and resolve helpers
git-svn-id: trunk@41022 -
This commit is contained in:
Mattias Gaertner
parent
cfd0790f89
commit
18f670a822
@ -119,7 +119,7 @@ const
|
||||
nWrongNumberOfParametersForArray = 3042;
|
||||
nCantAssignValuesToAnAddress = 3043;
|
||||
nIllegalExpression = 3044;
|
||||
nCantAccessPrivateMember = 3045;
|
||||
nCantAccessXMember = 3045;
|
||||
nMustBeInsideALoop = 3046;
|
||||
nExpectXArrayElementsButFoundY = 3047;
|
||||
nCannotCreateADescendantOfTheSealedXY = 3048;
|
||||
@ -178,6 +178,8 @@ const
|
||||
nFunctionHidesIdentifier_NonProc = 3112;
|
||||
nTypeXCannotBeExtendedByATypeHelper = 3113;
|
||||
nDerivedXMustExtendASubClassY = 3114;
|
||||
nDefaultPropertyNotAllowedInHelperForX = 3115;
|
||||
nHelpersCannotBeUsedAsTypes = 3116;
|
||||
|
||||
// using same IDs as FPC
|
||||
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
||||
@ -236,7 +238,7 @@ resourcestring
|
||||
sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
|
||||
sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
|
||||
sIllegalExpression = 'Illegal expression';
|
||||
sCantAccessPrivateMember = 'Can''t access %s member %s';
|
||||
sCantAccessXMember = 'Can''t access %s member %s';
|
||||
sMustBeInsideALoop = '%s must be inside a loop';
|
||||
sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
|
||||
sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
|
||||
@ -303,6 +305,8 @@ resourcestring
|
||||
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';
|
||||
sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
|
||||
sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
|
||||
|
||||
type
|
||||
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -741,6 +741,12 @@ type
|
||||
// okSpecialize removed in FPC 3.1.1
|
||||
okClassHelper,okRecordHelper,okTypeHelper,
|
||||
okDispInterface);
|
||||
const
|
||||
okWithFields = [okObject, okClass, okGeneric];
|
||||
okAllHelpers = [okClassHelper,okRecordHelper,okTypeHelper];
|
||||
okWithClassFields = okWithFields+okAllHelpers;
|
||||
|
||||
type
|
||||
|
||||
TPasClassInterfaceType = (
|
||||
citCom, // default
|
||||
@ -1074,11 +1080,25 @@ type
|
||||
end;
|
||||
|
||||
{ TPasOperator }
|
||||
TOperatorType = (otUnknown,otImplicit,otExplicit,otMul,otPlus, otMinus, otDivision,otLessThan, otEqual,
|
||||
otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
|
||||
otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
|
||||
otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
|
||||
otRightShift,otEnumerator, otIn);
|
||||
TOperatorType = (
|
||||
otUnknown,
|
||||
otImplicit, otExplicit,
|
||||
otMul, otPlus, otMinus, otDivision,
|
||||
otLessThan, otEqual, otGreaterThan,
|
||||
otAssign, otNotEqual, otLessEqualThan, otGreaterEqualThan,
|
||||
otPower, otSymmetricalDifference,
|
||||
otInc, otDec,
|
||||
otMod,
|
||||
otNegative, otPositive,
|
||||
otBitWiseOr,
|
||||
otDiv,
|
||||
otLeftShift,
|
||||
otLogicalOr,
|
||||
otBitwiseAnd, otbitwiseXor,
|
||||
otLogicalAnd, otLogicalNot, otLogicalXor,
|
||||
otRightShift,
|
||||
otEnumerator, otIn
|
||||
);
|
||||
TOperatorTypes = set of TOperatorType;
|
||||
|
||||
TPasOperator = class(TPasFunction)
|
||||
|
||||
@ -1452,7 +1452,7 @@ begin
|
||||
begin
|
||||
if Ref.WithExprScope<>nil then
|
||||
begin
|
||||
if Ref.WithExprScope.Scope is TPasRecordScope then
|
||||
if Ref.WithExprScope.ClassRecScope is TPasRecordScope then
|
||||
begin
|
||||
// a record member was accessed -> access the record too
|
||||
UseExprRef(El,Ref.WithExprScope.Expr,Access,false);
|
||||
|
||||
@ -135,7 +135,7 @@ resourcestring
|
||||
// free for 2029
|
||||
SLogStartImplementation = 'Start parsing implementation 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 Records';
|
||||
SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
|
||||
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
|
||||
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
|
||||
@ -731,11 +731,7 @@ begin
|
||||
end;
|
||||
Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
|
||||
if (poSkipDefaultDefs in Options) then
|
||||
begin
|
||||
Writeln('>>> Clearing <<<');
|
||||
Parser.ImplicitUses.Clear;
|
||||
end;
|
||||
Writeln('Implicit >>>',Parser.ImplicitUses.Text,'<<<');
|
||||
Filename := '';
|
||||
Parser.LogEvents:=AEngine.ParserLogEvents;
|
||||
Parser.OnLog:=AEngine.Onlog;
|
||||
@ -3353,13 +3349,27 @@ end;
|
||||
|
||||
procedure TPasParser.ParseDeclarations(Declarations: TPasDeclarations);
|
||||
var
|
||||
HadTypeSection: boolean;
|
||||
CurBlock: TDeclType;
|
||||
|
||||
procedure SetBlock(NewBlock: TDeclType);
|
||||
begin
|
||||
if CurBlock=NewBlock then exit;
|
||||
if CurBlock=declType then
|
||||
Engine.FinishScope(stTypeSection,Declarations);
|
||||
begin
|
||||
if msDelphi in CurrentModeswitches then
|
||||
// Delphi allows forward types only inside a type section
|
||||
Engine.FinishScope(stTypeSection,Declarations);
|
||||
end;
|
||||
if NewBlock=declType then
|
||||
HadTypeSection:=true
|
||||
else if (NewBlock=declNone) and HadTypeSection then
|
||||
begin
|
||||
HadTypeSection:=false;
|
||||
if not (msDelphi in CurrentModeswitches) then
|
||||
// ObjFPC allows forward types inside a whole section
|
||||
Engine.FinishScope(stTypeSection,Declarations);
|
||||
end;
|
||||
CurBlock:=NewBlock;
|
||||
Scanner.SetForceCaret(NewBlock=declType);
|
||||
end;
|
||||
@ -3383,6 +3393,7 @@ var
|
||||
RecordEl: TPasRecordType;
|
||||
begin
|
||||
CurBlock := declNone;
|
||||
HadTypeSection:=false;
|
||||
while True do
|
||||
begin
|
||||
if CurBlock in [DeclNone,declConst,declType] then
|
||||
@ -3655,7 +3666,7 @@ begin
|
||||
break;
|
||||
end
|
||||
else if (Declarations is TInterfaceSection)
|
||||
or (Declarations is TImplementationSection) then
|
||||
or (Declarations is TImplementationSection) then
|
||||
begin
|
||||
SetBlock(declNone);
|
||||
ParseInitialization;
|
||||
@ -4014,7 +4025,7 @@ begin
|
||||
end;
|
||||
if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
|
||||
ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
|
||||
[TokenInfos[tkComma], TokenInfos[tkColon], TokenInfos[tkGreaterThan]]);
|
||||
[TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
|
||||
until CurToken = tkGreaterThan;
|
||||
end;
|
||||
|
||||
@ -6227,7 +6238,7 @@ begin
|
||||
ptOperator,ptClassOperator:
|
||||
begin
|
||||
NextToken;
|
||||
IsTokenBased:=Curtoken<>tkIdentifier;
|
||||
IsTokenBased:=CurToken<>tkIdentifier;
|
||||
if IsTokenBased then
|
||||
OT:=TPasOperator.TokenToOperatorType(CurTokenText)
|
||||
else
|
||||
@ -6690,8 +6701,8 @@ Type
|
||||
Var
|
||||
CurVisibility : TPasMemberVisibility;
|
||||
CurSection : TSectionType;
|
||||
haveClass ,
|
||||
IsMethodResolution: Boolean; // true means last token was class keyword
|
||||
haveClass: boolean; // true means last token was class keyword
|
||||
IsMethodResolution: Boolean;
|
||||
LastToken: TToken;
|
||||
PropEl: TPasProperty;
|
||||
MethodRes: TPasMethodResolution;
|
||||
@ -6734,8 +6745,8 @@ begin
|
||||
tkVar:
|
||||
if not (CurSection in [stVar,stClassVar]) then
|
||||
begin
|
||||
if (AType.ObjKind in [okClass,okObject,okGeneric])
|
||||
or (haveClass and (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper])) then
|
||||
if (AType.ObjKind in okWithFields)
|
||||
or (haveClass and (AType.ObjKind in okAllHelpers)) then
|
||||
// ok
|
||||
else
|
||||
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
|
||||
@ -6759,14 +6770,14 @@ begin
|
||||
stNone,
|
||||
stVar:
|
||||
begin
|
||||
if not (AType.ObjKind in [okObject,okClass,okGeneric]) then
|
||||
if not (AType.ObjKind in okWithFields) then
|
||||
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
|
||||
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
|
||||
HaveClass:=False;
|
||||
end;
|
||||
stClassVar:
|
||||
begin
|
||||
if not (AType.ObjKind in [okObject,okClass,okGeneric,okClassHelper,okRecordHelper,okTypeHelper]) then
|
||||
if not (AType.ObjKind in okWithClassFields) then
|
||||
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
|
||||
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
|
||||
HaveClass:=False;
|
||||
@ -6780,12 +6791,19 @@ begin
|
||||
curSection:=stNone;
|
||||
if not haveClass then
|
||||
SaveComments;
|
||||
if (AType.ObjKind in [okObject,okClass,okGeneric])
|
||||
or ((CurToken=tkconstructor)
|
||||
and (AType.ObjKind in [okClassHelper,okTypeHelper,okRecordHelper])) then
|
||||
// ok
|
||||
case AType.ObjKind of
|
||||
okObject,okClass,okGeneric: ;
|
||||
okClassHelper,okTypeHelper,okRecordHelper:
|
||||
begin
|
||||
if (CurToken=tkdestructor) and not haveClass then
|
||||
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
|
||||
end;
|
||||
else
|
||||
ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
|
||||
if CurToken=tkconstructor then
|
||||
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['constructor',ObjKindNames[AType.ObjKind]])
|
||||
else
|
||||
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
|
||||
end;
|
||||
ProcessMethod(AType,HaveClass,CurVisibility);
|
||||
haveClass:=False;
|
||||
end;
|
||||
@ -6891,7 +6909,7 @@ begin
|
||||
NextToken;
|
||||
AType.IsShortDefinition:=(CurToken=tkSemicolon);
|
||||
end;
|
||||
if (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper]) then
|
||||
if (AType.ObjKind in okAllHelpers) then
|
||||
begin
|
||||
CheckToken(tkfor);
|
||||
NextToken;
|
||||
@ -6963,7 +6981,7 @@ begin
|
||||
AExternalNameSpace:='';
|
||||
AExternalName:='';
|
||||
end;
|
||||
if AObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
|
||||
if AObjKind in okAllHelpers then
|
||||
begin
|
||||
if not CurTokenIsIdentifier('Helper') then
|
||||
ParseExcSyntaxError;
|
||||
|
||||
@ -294,8 +294,9 @@ type
|
||||
msExternalClass, { Allow external class definitions }
|
||||
msPrefixedAttributes, { Allow attributes, disable proc modifier [] }
|
||||
msIgnoreAttributes, { workaround til resolver/converter supports attributes }
|
||||
msOmitRTTI { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
|
||||
);
|
||||
msOmitRTTI, { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
|
||||
msMultipleScopeHelpers { off=only one helper per type, on=all }
|
||||
);
|
||||
TModeSwitches = Set of TModeSwitch;
|
||||
|
||||
// switches, that can be 'on' or 'off'
|
||||
@ -987,7 +988,7 @@ const
|
||||
'Tab'
|
||||
);
|
||||
|
||||
SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[18]{$endif} =
|
||||
SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[20]{$endif} =
|
||||
( '', // msNone
|
||||
'', // Fpc,
|
||||
'', // Objfpc,
|
||||
@ -1037,7 +1038,8 @@ const
|
||||
'EXTERNALCLASS',
|
||||
'PREFIXEDATTRIBUTES',
|
||||
'IGNOREATTRIBUTES',
|
||||
'OMITRTTI'
|
||||
'OMITRTTI',
|
||||
'MULTIPLESCOPEHELPERS'
|
||||
);
|
||||
|
||||
LetterSwitchNames: array['A'..'Z'] of string=(
|
||||
|
||||
@ -12,20 +12,21 @@ Type
|
||||
{ TTestGenerics }
|
||||
|
||||
TTestGenerics = Class(TBaseTestTypeParser)
|
||||
private
|
||||
Published
|
||||
Procedure TestObjectGenerics;
|
||||
Procedure TestRecordGenerics;
|
||||
Procedure TestArrayGenerics;
|
||||
Procedure TestGenericConstraint;
|
||||
Procedure TestDeclarationConstraint;
|
||||
Procedure TestSpecializationDelphi;
|
||||
procedure TestDeclarationConstraint;
|
||||
Procedure TestDeclarationDelphi;
|
||||
Procedure TestDeclarationDelphiSpecialize;
|
||||
procedure TestDeclarationFPC;
|
||||
Procedure TestDeclarationFPC;
|
||||
Procedure TestMethodImplementation;
|
||||
Procedure TestInlineSpecializationInArgument;
|
||||
Procedure TestSpecializeNested;
|
||||
Procedure TestInlineSpecializeInStatement;
|
||||
Procedure TestGenericFunction; // ToDo
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -61,6 +62,37 @@ begin
|
||||
ParseDeclarations;
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGenericConstraint;
|
||||
begin
|
||||
Add([
|
||||
'Type',
|
||||
'Generic TSomeClass<T: TObject> = class',
|
||||
' b : T;',
|
||||
'end;',
|
||||
'']);
|
||||
ParseDeclarations;
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestDeclarationConstraint;
|
||||
Var
|
||||
T : TPasClassType;
|
||||
begin
|
||||
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
|
||||
Source.Add('Type');
|
||||
Source.Add(' TSomeClass<T: T2> = Class(TObject)');
|
||||
Source.Add(' b : T;');
|
||||
Source.Add('end;');
|
||||
ParseDeclarations;
|
||||
AssertNotNull('have generic definition',Declarations.Classes);
|
||||
AssertEquals('have generic definition',1,Declarations.Classes.Count);
|
||||
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
|
||||
T:=TPasClassType(Declarations.Classes[0]);
|
||||
AssertNotNull('have generic templates',T.GenericTemplateTypes);
|
||||
AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
|
||||
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
|
||||
AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestSpecializationDelphi;
|
||||
begin
|
||||
ParseType('TFPGList<integer>',TPasSpecializeType,'');
|
||||
@ -87,48 +119,6 @@ begin
|
||||
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestDeclarationFPC;
|
||||
Var
|
||||
T : TPasClassType;
|
||||
begin
|
||||
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
|
||||
Source.Add('Type');
|
||||
Source.Add(' TSomeClass<T;T2> = Class(TObject)');
|
||||
Source.Add(' b : T;');
|
||||
Source.Add(' b2 : T2;');
|
||||
Source.Add('end;');
|
||||
ParseDeclarations;
|
||||
AssertNotNull('have generic definition',Declarations.Classes);
|
||||
AssertEquals('have generic definition',1,Declarations.Classes.Count);
|
||||
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
|
||||
T:=TPasClassType(Declarations.Classes[0]);
|
||||
AssertNotNull('have generic templates',T.GenericTemplateTypes);
|
||||
AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
|
||||
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
|
||||
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestGenerics.TestDeclarationConstraint;
|
||||
Var
|
||||
T : TPasClassType;
|
||||
begin
|
||||
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
|
||||
Source.Add('Type');
|
||||
Source.Add(' TSomeClass<T: T2> = Class(TObject)');
|
||||
Source.Add(' b : T;');
|
||||
Source.Add('end;');
|
||||
ParseDeclarations;
|
||||
AssertNotNull('have generic definition',Declarations.Classes);
|
||||
AssertEquals('have generic definition',1,Declarations.Classes.Count);
|
||||
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
|
||||
T:=TPasClassType(Declarations.Classes[0]);
|
||||
AssertNotNull('have generic templates',T.GenericTemplateTypes);
|
||||
AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
|
||||
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
|
||||
AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestDeclarationDelphiSpecialize;
|
||||
Var
|
||||
T : TPasClassType;
|
||||
@ -151,6 +141,27 @@ begin
|
||||
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestDeclarationFPC;
|
||||
Var
|
||||
T : TPasClassType;
|
||||
begin
|
||||
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
|
||||
Source.Add('Type');
|
||||
Source.Add(' TSomeClass<T;T2> = Class(TObject)');
|
||||
Source.Add(' b : T;');
|
||||
Source.Add(' b2 : T2;');
|
||||
Source.Add('end;');
|
||||
ParseDeclarations;
|
||||
AssertNotNull('have generic definition',Declarations.Classes);
|
||||
AssertEquals('have generic definition',1,Declarations.Classes.Count);
|
||||
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
|
||||
T:=TPasClassType(Declarations.Classes[0]);
|
||||
AssertNotNull('have generic templates',T.GenericTemplateTypes);
|
||||
AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
|
||||
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
|
||||
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestMethodImplementation;
|
||||
begin
|
||||
With source do
|
||||
@ -206,6 +217,19 @@ begin
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGenericFunction;
|
||||
begin
|
||||
exit; // ToDo
|
||||
Add([
|
||||
'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
' IfThen<word>(true,2,3);',
|
||||
'']);
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TTestGenerics);
|
||||
end.
|
||||
|
||||
@ -1273,18 +1273,20 @@ procedure TTestProcedureFunction.TestOperatorNames;
|
||||
|
||||
Var
|
||||
t : TOperatorType;
|
||||
S: String;
|
||||
|
||||
begin
|
||||
For t:=Succ(otUnknown) to High(TOperatorType) do
|
||||
begin
|
||||
S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
|
||||
ResetParser;
|
||||
if t in UnaryOperators then
|
||||
AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorNames[t]]))
|
||||
else
|
||||
AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorNames[t]]));
|
||||
ParseOperator;
|
||||
AssertEquals('Token based',False,FOperator.TokenBased);
|
||||
AssertEquals('Correct operator type',T,FOperator.OperatorType);
|
||||
AssertEquals(S+': Token based',t in [otIn],FOperator.TokenBased);
|
||||
AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
|
||||
if t in UnaryOperators then
|
||||
AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
|
||||
else
|
||||
|
||||
@ -490,6 +490,7 @@ type
|
||||
Procedure TestAdvRecord;
|
||||
Procedure TestAdvRecord_Private;
|
||||
Procedure TestAdvRecord_StrictPrivate;
|
||||
Procedure TestAdvRecord_StrictPrivateFail;
|
||||
Procedure TestAdvRecord_MethodImplMissingFail;
|
||||
Procedure TestAdvRecord_VarConst;
|
||||
Procedure TestAdvRecord_RecVal_ConstFail;
|
||||
@ -520,6 +521,9 @@ type
|
||||
Procedure TestClassForwardAsAncestorFail;
|
||||
Procedure TestClassForwardNotResolved;
|
||||
Procedure TestClassForwardDuplicateFail;
|
||||
Procedure TestClassForwardDelphiFail;
|
||||
Procedure TestClassForwardObjFPCProgram;
|
||||
Procedure TestClassForwardObjFPCUnit;
|
||||
Procedure TestClass_Method;
|
||||
Procedure TestClass_ConstructorMissingDotFail;
|
||||
Procedure TestClass_MethodImplDuplicateFail;
|
||||
@ -658,6 +662,8 @@ type
|
||||
Procedure TestPropertyReadAccessorFuncWrongResult;
|
||||
Procedure TestPropertyReadAccessorFuncWrongArgCount;
|
||||
Procedure TestPropertyReadAccessorFunc;
|
||||
Procedure TestPropertyReadAccessorStrictPrivate;
|
||||
Procedure TestPropertyReadAccessorNonClassFail;
|
||||
Procedure TestPropertyWriteAccessorVarWrongType;
|
||||
Procedure TestPropertyWriteAccessorFuncNotProc;
|
||||
Procedure TestPropertyWriteAccessorProcWrongArgCount;
|
||||
@ -863,12 +869,35 @@ type
|
||||
// helpers
|
||||
Procedure ClassHelper;
|
||||
Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
|
||||
Procedure ClassHelper_HelperForParentFail;
|
||||
Procedure ClassHelper_ForInterfaceFail;
|
||||
Procedure ClassHelper_FieldFail;
|
||||
Procedure ClassHelper_AbstractFail;
|
||||
Procedure ClassHelper_VirtualObjFPCFail;
|
||||
Procedure ClassHelper_VirtualDelphiFail;
|
||||
Procedure ClassHelper_DestructorFail;
|
||||
Procedure ClassHelper_ClassRefersToTypeHelperOfAncestor;
|
||||
Procedure ClassHelper_InheritedObjFPC;
|
||||
Procedure ClassHelper_InheritedObjFPC2;
|
||||
Procedure ClassHelper_InheritedObjFPCStrictPrivateFail;
|
||||
Procedure ClassHelper_InheritedDelphi;
|
||||
Procedure ClassHelper_NestedInheritedParentFail;
|
||||
Procedure ClassHelper_AccessFields;
|
||||
Procedure ClassHelper_CallClassMethodFail;
|
||||
Procedure ClassHelper_AsTypeFail;
|
||||
Procedure ClassHelper_Enumerator;
|
||||
Procedure ClassHelper_FromUnitInterface;
|
||||
// ToDo ClassHelper_Constructor
|
||||
// ToDo ClassHelper_DefaultProperty
|
||||
// ToDo ClassHelper_MultiScopeHelpers
|
||||
Procedure RecordHelper;
|
||||
// RecordHelper_Constructor
|
||||
Procedure TypeHelper;
|
||||
Procedure TypeHelper_HelperForProcTypeFail;
|
||||
Procedure TypeHelper_DefaultPropertyFail;
|
||||
Procedure TypeHelper_Enum;
|
||||
Procedure TypeHelper_Enumerator;
|
||||
// TypeHelper_Constructor
|
||||
|
||||
// attributes
|
||||
Procedure TestAttributes_Ignore;
|
||||
@ -7872,6 +7901,30 @@ begin
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_StrictPrivate;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch advancedrecords}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' strict private',
|
||||
' FSize: longword;',
|
||||
' function GetSize: longword;',
|
||||
' public',
|
||||
' property Size: longword read GetSize write FSize;',
|
||||
' end;',
|
||||
'function TRec.GetSize: longword;',
|
||||
'begin',
|
||||
' FSize:=GetSize;',
|
||||
'end;',
|
||||
'var',
|
||||
' r: TRec;',
|
||||
'begin',
|
||||
' r.Size:=r.Size;']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_StrictPrivateFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -7885,7 +7938,7 @@ begin
|
||||
' r: TRec;',
|
||||
'begin',
|
||||
' r.a:=r.a;']);
|
||||
CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
|
||||
CheckResolverException('Can''t access strict private member A',nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAdvRecord_MethodImplMissingFail;
|
||||
@ -8616,6 +8669,62 @@ begin
|
||||
CheckResolverException('Duplicate identifier "TObject" at afile.pp(3,10)',nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassForwardDelphiFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class;',
|
||||
'const k = 1;',
|
||||
'type',
|
||||
' TBird = class',
|
||||
' end;',
|
||||
'begin']);
|
||||
CheckResolverException('Forward type not resolved "TBird"',nForwardTypeNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassForwardObjFPCProgram;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class;',
|
||||
'const k = 1;',
|
||||
'type',
|
||||
' TBird = class',
|
||||
' end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassForwardObjFPCUnit;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'interface',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class;',
|
||||
'const k = 1;',
|
||||
'type',
|
||||
' TBird = class',
|
||||
' end;',
|
||||
'implementation',
|
||||
'type',
|
||||
' TEagle = class;',
|
||||
'const c = 1;',
|
||||
'type',
|
||||
' TEagle = class',
|
||||
' end;',
|
||||
'']);
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_Method;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -9912,7 +10021,7 @@ begin
|
||||
Add('begin');
|
||||
Add(' if o.v=3 then ;');
|
||||
CheckResolverException('Can''t access private member v',
|
||||
nCantAccessPrivateMember);
|
||||
nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PrivateInDescendantFail;
|
||||
@ -9940,7 +10049,7 @@ begin
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Can''t access private member v',
|
||||
nCantAccessPrivateMember);
|
||||
nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_ProtectedInDescendant;
|
||||
@ -10002,7 +10111,7 @@ begin
|
||||
Add('begin');
|
||||
Add(' if o.v=3 then ;');
|
||||
CheckResolverException('Can''t access strict private member v',
|
||||
nCantAccessPrivateMember);
|
||||
nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_StrictProtectedInMainBeginFail;
|
||||
@ -10017,7 +10126,7 @@ begin
|
||||
Add('begin');
|
||||
Add(' if o.v=3 then ;');
|
||||
CheckResolverException('Can''t access strict protected member v',
|
||||
nCantAccessPrivateMember);
|
||||
nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_Constructor_NewInstance;
|
||||
@ -10809,7 +10918,7 @@ begin
|
||||
' Arm: TObject.TArm;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Can''t access strict private member TArm',nCantAccessPrivateMember);
|
||||
CheckResolverException('Can''t access strict private member TArm',nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestNestedClass_AccessStrictPrivate;
|
||||
@ -11580,6 +11689,42 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorStrictPrivate;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' strict private',
|
||||
' FSize: word;',
|
||||
' property Size: word read FSize;',
|
||||
' strict protected',
|
||||
' FName: string;',
|
||||
' property Name: string read FName;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' strict protected',
|
||||
' property Caption: string read FName;',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorNonClassFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' FSize: word;',
|
||||
' class property Size: word read FSize;',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('class var expected, but var found',nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyWriteAccessorVarWrongType;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -12219,7 +12364,7 @@ begin
|
||||
' constructor Create;',
|
||||
' end;',
|
||||
'begin']);
|
||||
CheckParserException(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
|
||||
CheckParserException('constructor is not allowed in interface',nParserXNotAllowedInY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassInterface_DelphiClassAncestorIntfFail;
|
||||
@ -15203,7 +15348,6 @@ begin
|
||||
' PInteger = ^integer;',
|
||||
'var',
|
||||
' i: integer;',
|
||||
' p1: PInteger;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('identifier not found "integer"',nIdentifierNotFound);
|
||||
@ -15544,6 +15688,24 @@ begin
|
||||
nDerivedXMustExtendASubClassY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_HelperForParentFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TBird = class(TObject)',
|
||||
' type',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' end;',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sTypeXIsNotYetCompletelyDefined,
|
||||
nTypeXIsNotYetCompletelyDefined);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_ForInterfaceFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -15611,6 +15773,405 @@ begin
|
||||
nInvalidXModifierY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_VirtualDelphiFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'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.ClassHelper_DestructorFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' destructor Destroyer;',
|
||||
' end;',
|
||||
'destructor TObjHelper.Destroyer;',
|
||||
'begin end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckParserException('destructor is not allowed in class helper',
|
||||
nParserXNotAllowedInY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_ClassRefersToTypeHelperOfAncestor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' type',
|
||||
' TInt = word;',
|
||||
' function GetSize: TInt;',
|
||||
' end;',
|
||||
' TAnt = class',
|
||||
' procedure SetSize(Value: TInt);',
|
||||
' property Size: TInt read GetSize write SetSize;',
|
||||
' end;',
|
||||
'function Tobjhelper.getSize: TInt;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure TAnt.SetSize(Value: TInt);',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_InheritedObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure {#TObject_Fly}Fly;',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' procedure {#TObjHelper_Fly}Fly;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure {#TBird_Fly}Fly;',
|
||||
' end;',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' procedure {#TBirdHelper_Fly}Fly;',
|
||||
' procedure {#TBirdHelper_Walk}Walk;',
|
||||
' end;',
|
||||
' TEagleHelper = class helper(TBirdHelper) for TBird',
|
||||
' procedure {#TEagleHelper_Fly}Fly;',
|
||||
' procedure {#TEagleHelper_Walk}Walk;',
|
||||
' end;',
|
||||
'procedure Tobject.fly;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
'end;',
|
||||
'procedure Tobjhelper.fly;',
|
||||
'begin',
|
||||
' {@TObject_Fly}inherited;',
|
||||
' inherited {@TObject_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbird.fly;',
|
||||
'begin',
|
||||
' {@TObjHelper_Fly}inherited;',
|
||||
' inherited {@TObjHelper_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbirdhelper.fly;',
|
||||
'begin',
|
||||
' {@TBird_Fly}inherited;',
|
||||
' inherited {@TBird_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbirdhelper.walk;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure teagleHelper.fly;',
|
||||
'begin',
|
||||
' {@TBird_Fly}inherited;',
|
||||
' inherited {@TBird_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure teagleHelper.walk;',
|
||||
'begin',
|
||||
' {@TBirdHelper_Walk}inherited;',
|
||||
' inherited {@TBirdHelper_Walk}Walk;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_InheritedObjFPC2;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure {#TObject_Fly}Fly;',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' procedure {#TObjHelper_Walk}Walk;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure {#TBird_Fly}Fly;',
|
||||
' end;',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' procedure {#TBirdHelper_Walk}Walk;',
|
||||
' end;',
|
||||
' TEagleHelper = class helper(TBirdHelper) for TBird',
|
||||
' procedure {#TEagleHelper_Walk}Walk;',
|
||||
' end;',
|
||||
'procedure Tobject.fly;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
'end;',
|
||||
'procedure Tobjhelper.walk;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
'end;',
|
||||
'procedure Tbird.fly;',
|
||||
'begin',
|
||||
' {@TObject_Fly}inherited;', // no helper, search further in ancestor
|
||||
' inherited {@TObject_Fly}Fly;', // no helper, search further in ancestor
|
||||
'end;',
|
||||
'procedure Tbirdhelper.walk;',
|
||||
'begin',
|
||||
' {@TObjHelper_Walk}inherited;',
|
||||
' inherited {@TObjHelper_Walk}Walk;',
|
||||
'end;',
|
||||
'procedure teagleHelper.walk;',
|
||||
'begin',
|
||||
' {@TObjHelper_Walk}inherited;',
|
||||
' inherited {@TObjHelper_Walk}Walk;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_InheritedObjFPCStrictPrivateFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' strict private i: word;',
|
||||
' end;',
|
||||
' THelper = class helper for TObject',
|
||||
' property a: word read i;',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Can''t access strict private member i',nCantAccessXMember);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_InheritedDelphi;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure {#TObject_Fly}Fly;',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' procedure {#TObjHelper_Fly}Fly;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure {#TBird_Fly}Fly;',
|
||||
' end;',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' procedure {#TBirdHelper_Fly}Fly;',
|
||||
' procedure {#TBirdHelper_Walk}Walk;',
|
||||
' end;',
|
||||
' TEagleHelper = class helper(TBirdHelper) for TBird',
|
||||
' procedure {#TEagleHelper_Fly}Fly;',
|
||||
' procedure {#TEagleHelper_Walk}Walk;',
|
||||
' end;',
|
||||
'procedure Tobject.fly;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
'end;',
|
||||
'procedure Tobjhelper.fly;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
' inherited {@TObject_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbird.fly;',
|
||||
'begin',
|
||||
' {@TObjHelper_Fly}inherited;',
|
||||
' inherited {@TObjHelper_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbirdhelper.fly;',
|
||||
'begin',
|
||||
' {@TObjHelper_Fly}inherited;',// skip helperfortype too
|
||||
' inherited {@TBird_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure Tbirdhelper.walk;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure teagleHelper.fly;',
|
||||
'begin',
|
||||
' {@TObjHelper_Fly}inherited;',// skip helperfortype too
|
||||
' inherited {@TBird_Fly}Fly;',
|
||||
'end;',
|
||||
'procedure teagleHelper.walk;',
|
||||
'begin',
|
||||
' inherited;', // ignore
|
||||
' inherited {@TBirdHelper_Walk}Walk;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_NestedInheritedParentFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure Fly;',
|
||||
' type',
|
||||
' TBirdHelper = class helper for TObject',
|
||||
' procedure Fly;',
|
||||
' end;',
|
||||
' end;',
|
||||
'procedure TBird.fly;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure TBird.Tbirdhelper.fly;',
|
||||
'begin',
|
||||
' inherited Fly;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('identifier not found "Fly"',nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_AccessFields;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class',
|
||||
' Size: word;',
|
||||
' FItems: array of word;',
|
||||
' end;',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' procedure Fly;',
|
||||
' end;',
|
||||
'procedure TBirdHelper.Fly;',
|
||||
'begin',
|
||||
' Size:=FItems[0];',
|
||||
' Self.Size:=Self.FItems[0];',
|
||||
'end;',
|
||||
'var',
|
||||
' b: TBird;',
|
||||
'begin',
|
||||
' b.Fly;',
|
||||
' b.Fly()',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_CallClassMethodFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' THelper = class helper for TObject',
|
||||
' class procedure Fly;',
|
||||
' end;',
|
||||
'class procedure THelper.Fly;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
' THelper.Fly;',
|
||||
'']);
|
||||
CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_AsTypeFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' THelper = class helper for TObject',
|
||||
' end;',
|
||||
'var h: THelper;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sHelpersCannotBeUsedAsTypes,nHelpersCannotBeUsedAsTypes);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_Enumerator;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TItem = TObject;',
|
||||
' TEnumerator = class',
|
||||
' FCurrent: TItem;',
|
||||
' property Current: TItem read FCurrent;',
|
||||
' function MoveNext: boolean;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' FItems: array of TItem;',
|
||||
' end;',
|
||||
' TBirdHelper = class helper for TBird',
|
||||
' function GetEnumerator: TEnumerator;',
|
||||
' end;',
|
||||
'function TEnumerator.MoveNext: boolean;',
|
||||
'begin',
|
||||
'end;',
|
||||
'function TBirdHelper.GetEnumerator: TEnumerator;',
|
||||
'begin',
|
||||
' Result.FCurrent:=FItems[0];',
|
||||
' Result.FCurrent:=Self.FItems[0];',
|
||||
'end;',
|
||||
'var',
|
||||
' b: TBird;',
|
||||
' i: TItem;',
|
||||
' {#i2}i2: TItem;',
|
||||
'begin',
|
||||
' for i in b do {@i2}i2:=i;']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.ClassHelper_FromUnitInterface;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pas',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' public',
|
||||
' Id: word;',
|
||||
' end;',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' property Size: word read ID write ID;',
|
||||
' end;',
|
||||
'']),
|
||||
'');
|
||||
AddModuleWithIntfImplSrc('unit3.pas',
|
||||
LinesToStr([
|
||||
'uses unit2;',
|
||||
'type',
|
||||
' TObjHelper = class helper for TObject',
|
||||
' property Size: word read ID write ID;',
|
||||
' end;',
|
||||
'']),
|
||||
'');
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unit2, unit3;',
|
||||
'var o: TObject;',
|
||||
'begin',
|
||||
' o.Size:=o.Size;']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.RecordHelper;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -15618,6 +16179,7 @@ begin
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TRec = record',
|
||||
' x: word;',
|
||||
' end;',
|
||||
' TRecHelper = record helper for TRec',
|
||||
' type T = word;',
|
||||
@ -15627,10 +16189,19 @@ begin
|
||||
' class var',
|
||||
' v: T;',
|
||||
' w: T;',
|
||||
' procedure Fly;',
|
||||
' end;',
|
||||
' TAnt = word;',
|
||||
' TAntHelper = record helper for TAnt',
|
||||
' end;',
|
||||
'procedure TRecHelper.Fly;',
|
||||
'var r: TRec;',
|
||||
'begin',
|
||||
' Self:=r;',
|
||||
' r:=Self;',
|
||||
' c:=v+x;',
|
||||
' x:=k+w;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
@ -15652,6 +16223,99 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TypeHelper_HelperForProcTypeFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch typehelpers}',
|
||||
'type',
|
||||
' TProc = procedure;',
|
||||
' THelper = type helper for TProc',
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Type "TProc" cannot be extended by a type helper',
|
||||
nTypeXCannotBeExtendedByATypeHelper);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TypeHelper_DefaultPropertyFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch typehelpers}',
|
||||
'type',
|
||||
' TStringHelper = type helper for string',
|
||||
' end;',
|
||||
' TCaption = string;',
|
||||
' TCapHelper = type helper(TStringHelper) for TCaption',
|
||||
' function GetItems(Index: boolean): boolean;',
|
||||
' property Items[Index: boolean]: boolean read GetItems; default;',
|
||||
' end;',
|
||||
'function TCapHelper.GetItems(Index: boolean): boolean; begin end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Default property not allowed in helper for TCaption',
|
||||
nDefaultPropertyNotAllowedInHelperForX);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TypeHelper_Enum;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch typehelpers}',
|
||||
'type',
|
||||
' TFlag = (Red, Green, Blue);',
|
||||
' THelper = type helper for TFlag',
|
||||
' function toString: string;',
|
||||
' end;',
|
||||
'function THelper.toString: string;',
|
||||
'begin',
|
||||
' Self:=Red;',
|
||||
' if Self=TFlag.Blue then ;',
|
||||
' Result:=str(Self);',
|
||||
'end;',
|
||||
'var',
|
||||
' f: TFlag;',
|
||||
'begin',
|
||||
' f.toString;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TypeHelper_Enumerator;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch typehelpers}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TItem = byte;',
|
||||
' TEnumerator = class',
|
||||
' FCurrent: TItem;',
|
||||
' property Current: TItem read FCurrent;',
|
||||
' function MoveNext: boolean;',
|
||||
' end;',
|
||||
' TWordHelper = type helper for Word',
|
||||
' function GetEnumerator: TEnumerator;',
|
||||
' end;',
|
||||
'function TEnumerator.MoveNext: boolean;',
|
||||
'begin',
|
||||
'end;',
|
||||
'function TWordHelper.GetEnumerator: TEnumerator;',
|
||||
'begin',
|
||||
' if Self=2 then ;',
|
||||
' Self:=Self+3;',
|
||||
'end;',
|
||||
'var',
|
||||
' w: word;',
|
||||
' i: TItem;',
|
||||
' {#i2}i2: TItem;',
|
||||
'begin',
|
||||
' w.GetEnumerator;',
|
||||
' for i in w do {@i2}i2:=i;']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAttributes_Ignore;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user