mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-15 11:49:27 +02:00
fcl-passrc: fixed checking proc arg base type from different units, fixed scanner eof row, fixed fail test messages
git-svn-id: trunk@35728 -
This commit is contained in:
Mattias Gaertner
parent
6580dfee39
commit
58791a0b5c
@ -125,6 +125,7 @@ Works:
|
||||
- Delphi without @
|
||||
- FPC equal and not equal
|
||||
- "is nested"
|
||||
- bark on arguments access mismatch
|
||||
- function without params: mark if call or address, rrfImplicitCallWithoutParams
|
||||
- procedure break, procedure continue
|
||||
- built-in functions pred, succ for range type and enums
|
||||
@ -212,7 +213,7 @@ const
|
||||
nCantDetermineWhichOverloadedFunctionToCall = 3013;
|
||||
nForwardTypeNotResolved = 3014;
|
||||
nForwardProcNotResolved = 3015;
|
||||
nInvalidXModifiersY = 3016;
|
||||
nInvalidXModifierY = 3016;
|
||||
nAbstractMethodsMustNotHaveImplementation = 3017;
|
||||
nCallingConventionMismatch = 3018;
|
||||
nResultTypeMismatchExpectedButFound = 3019;
|
||||
@ -249,6 +250,8 @@ const
|
||||
nVirtualMethodXHasLowerVisibility = 3050; // FPC 3250
|
||||
nExternalClassInstanceCannotAccessStaticX = 3051;
|
||||
nXModifierMismatchY = 3052;
|
||||
nSymbolCannotBePublished = 3053;
|
||||
nCannotTypecastAType = 3054;
|
||||
|
||||
// resourcestring patterns of messages
|
||||
resourcestring
|
||||
@ -267,7 +270,7 @@ resourcestring
|
||||
sCantDetermineWhichOverloadedFunctionToCall = 'Can''t determine which overloaded function to call';
|
||||
sForwardTypeNotResolved = 'Forward type not resolved "%s"';
|
||||
sForwardProcNotResolved = 'Forward %s not resolved "%s"';
|
||||
sInvalidXModifiersY = 'Invalid %s modifiers %s';
|
||||
sInvalidXModifierY = 'Invalid %s modifier %s';
|
||||
sAbstractMethodsMustNotHaveImplementation = 'Abstract method must not have an implementation.';
|
||||
sCallingConventionMismatch = 'Calling convention mismatch';
|
||||
sResultTypeMismatchExpectedButFound = 'Result type mismatch, expected %s, but found %s';
|
||||
@ -304,6 +307,8 @@ resourcestring
|
||||
sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
|
||||
sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
|
||||
sXModifierMismatchY = '%s modifier "%s" mismatch';
|
||||
sSymbolCannotBePublished = 'Symbol cannot be published. Only methods and properties.';
|
||||
sCannotTypecastAType = 'Cannot type cast a type';
|
||||
|
||||
type
|
||||
TResolverBaseType = (
|
||||
@ -581,10 +586,6 @@ type
|
||||
pikBuiltInProc, // e.g. High(), SetLength()
|
||||
pikSimple, // simple vars, consts, types, enums
|
||||
pikProc // may need parameter list with round brackets
|
||||
{
|
||||
pikIndexedProperty, // may need parameter list with edged brackets
|
||||
pikGeneric, // may need parameter list with angle brackets
|
||||
pikDottedUses // namespace, needs dotted identifierss }
|
||||
);
|
||||
TPasIdentifierKinds = set of TPasIdentifierKind;
|
||||
|
||||
@ -1288,11 +1289,11 @@ type
|
||||
procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
|
||||
procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
|
||||
procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; const DescA,DescB: String; ErrorEl: TPasElement);
|
||||
const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
|
||||
procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; TypeA, TypeB: TPasType; ErrorEl: TPasElement);
|
||||
const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
|
||||
procedure RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; const TypeA, TypeB: TPasResolverResult;
|
||||
const Args: array of const; const GotType, ExpType: TPasResolverResult;
|
||||
ErrorEl: TPasElement);
|
||||
procedure WriteScopes;
|
||||
// find value and type of an element
|
||||
@ -1478,6 +1479,8 @@ function GetTypeDesc(aType: TPasType; AddPath: boolean): string;
|
||||
s: String;
|
||||
begin
|
||||
Result:=aType.Name;
|
||||
if Result='' then
|
||||
Result:=aType.ElementTypeName;
|
||||
if AddPath then
|
||||
begin
|
||||
s:=aType.FullPath;
|
||||
@ -1489,7 +1492,7 @@ function GetTypeDesc(aType: TPasType; AddPath: boolean): string;
|
||||
var
|
||||
C: TClass;
|
||||
begin
|
||||
if aType=nil then exit('nil');
|
||||
if aType=nil then exit('untyped');
|
||||
C:=aType.ClassType;
|
||||
if (C=TPasUnresolvedSymbolRef) then
|
||||
begin
|
||||
@ -1718,7 +1721,7 @@ begin
|
||||
if length(ArrayEl.Ranges)=0 then
|
||||
Result:='array of '+ArrayEl.ElType.Name
|
||||
else
|
||||
Result:='array[] of '+ArrayEl.ElType.Name;
|
||||
Result:='static array[] of '+ArrayEl.ElType.Name;
|
||||
end
|
||||
else if T.TypeEl is TPasProcedureType then
|
||||
Result:=GetProcDesc(TPasProcedureType(T.TypeEl),false)
|
||||
@ -2857,8 +2860,21 @@ var
|
||||
Identifier, OlderIdentifier: TPasIdentifier;
|
||||
ClassScope: TPasClassScope;
|
||||
OlderEl: TPasElement;
|
||||
IsClassScope: Boolean;
|
||||
begin
|
||||
if (Kind=pikSimple) and (Scope is TPasClassScope)
|
||||
IsClassScope:=(Scope is TPasClassScope);
|
||||
|
||||
if (El.Visibility=visPublished) then
|
||||
begin
|
||||
if El.ClassType=TPasProperty then
|
||||
// Note: VarModifiers are not yet set
|
||||
else if (El.ClassType=TPasProcedure) or (El.ClassType=TPasFunction) then
|
||||
// ok
|
||||
else
|
||||
RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
|
||||
end;
|
||||
|
||||
if (Kind=pikSimple) and IsClassScope
|
||||
and (El.ClassType<>TPasProperty) then
|
||||
begin
|
||||
// check duplicate in ancestors
|
||||
@ -2890,7 +2906,9 @@ begin
|
||||
// check duplicate in current scope
|
||||
OlderIdentifier:=Identifier.NextSameIdentifier;
|
||||
if (OlderIdentifier<>nil) then
|
||||
if (Identifier.Kind=pikSimple) or (OlderIdentifier.Kind=pikSimple) then
|
||||
if (Identifier.Kind=pikSimple)
|
||||
or (OlderIdentifier.Kind=pikSimple)
|
||||
or (El.Visibility=visPublished) then
|
||||
begin
|
||||
if (OlderIdentifier.Element.ClassType=TPasEnumValue)
|
||||
and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
|
||||
@ -3267,8 +3285,8 @@ begin
|
||||
pmStatic, pmVarargs,
|
||||
pmExternal, pmDispId,
|
||||
pmfar]) then
|
||||
RaiseMsg(20170216151616,nInvalidXModifiersY,
|
||||
sInvalidXModifiersY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
|
||||
RaiseMsg(20170216151616,nInvalidXModifierY,
|
||||
sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
|
||||
|
||||
if Proc.Parent is TPasClassType then
|
||||
begin
|
||||
@ -3276,31 +3294,31 @@ begin
|
||||
if Proc.IsAbstract then
|
||||
begin
|
||||
if not Proc.IsVirtual then
|
||||
RaiseMsg(20170216151623,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
|
||||
RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
|
||||
if Proc.IsOverride then
|
||||
RaiseMsg(20170216151625,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract, override'],Proc);
|
||||
RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract, override'],Proc);
|
||||
end;
|
||||
if Proc.IsVirtual and Proc.IsOverride then
|
||||
RaiseMsg(20170216151627,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'virtual, override'],Proc);
|
||||
RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual, override'],Proc);
|
||||
if Proc.IsForward then
|
||||
RaiseMsg(20170216151629,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'forward'],Proc);
|
||||
RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'forward'],Proc);
|
||||
if Proc.IsStatic then
|
||||
if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
|
||||
RaiseMsg(20170216151631,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'static'],Proc);
|
||||
RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// intf proc, forward proc, proc body, method body
|
||||
if Proc.IsAbstract then
|
||||
RaiseMsg(20170216151634,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'abstract'],Proc);
|
||||
RaiseMsg(20170216151634,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract'],Proc);
|
||||
if Proc.IsVirtual then
|
||||
RaiseMsg(20170216151635,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'virtual'],Proc);
|
||||
RaiseMsg(20170216151635,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual'],Proc);
|
||||
if Proc.IsOverride then
|
||||
RaiseMsg(20170216151637,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'override'],Proc);
|
||||
RaiseMsg(20170216151637,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'override'],Proc);
|
||||
if Proc.IsMessage then
|
||||
RaiseMsg(20170216151638,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'message'],Proc);
|
||||
RaiseMsg(20170216151638,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'message'],Proc);
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(20170216151640,nInvalidXModifiersY,sInvalidXModifiersY,[Proc.ElementTypeName,'static'],Proc);
|
||||
RaiseMsg(20170216151640,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
|
||||
end;
|
||||
|
||||
if Pos('.',ProcName)>1 then
|
||||
@ -3479,9 +3497,9 @@ var
|
||||
p: Integer;
|
||||
begin
|
||||
if ImplProc.IsExternal then
|
||||
RaiseMsg(20170216151715,nInvalidXModifiersY,sInvalidXModifiersY,[ImplProc.ElementTypeName,'external'],ImplProc);
|
||||
RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'external'],ImplProc);
|
||||
if ImplProc.IsExported then
|
||||
RaiseMsg(20170216151717,nInvalidXModifiersY,sInvalidXModifiersY,[ImplProc.ElementTypeName,'export'],ImplProc);
|
||||
RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'export'],ImplProc);
|
||||
|
||||
ProcName:=ImplProc.Name;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
@ -3587,6 +3605,8 @@ end;
|
||||
|
||||
procedure TPasResolver.FinishVariable(El: TPasVariable);
|
||||
begin
|
||||
if (El.Visibility=visPublished) then
|
||||
RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
|
||||
if El.Expr<>nil then
|
||||
begin
|
||||
ResolveExpr(El.Expr,rraRead);
|
||||
@ -3701,7 +3721,8 @@ var
|
||||
// check access: var, const, ...
|
||||
if PropArg.Access<>ProcArg.Access then
|
||||
RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),AccessNames[ProcArg.Access],AccessNames[PropArg.Access]],ErrorEl);
|
||||
[IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
|
||||
AccessDescriptions[PropArg.Access]],ErrorEl);
|
||||
|
||||
// check typed
|
||||
if PropArg.ArgType=nil then
|
||||
@ -3740,10 +3761,17 @@ var
|
||||
Arg: TPasArgument;
|
||||
PropArgCount: Integer;
|
||||
PropTypeResolved, DefaultResolved: TPasResolverResult;
|
||||
m: TVariableModifier;
|
||||
begin
|
||||
CheckTopScope(TPasPropertyScope);
|
||||
PopScope;
|
||||
|
||||
if PropEl.Visibility=visPublished then
|
||||
for m in PropEl.VarModifiers do
|
||||
if not (m in [vmExternal]) then
|
||||
RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
|
||||
['published property','"'+VariableModifierNames[m]+'"'],PropEl);
|
||||
|
||||
PropType:=nil;
|
||||
CurClassType:=PropEl.Parent as TPasClassType;
|
||||
ClassScope:=CurClassType.CustomData as TPasClassScope;
|
||||
@ -3848,7 +3876,8 @@ begin
|
||||
Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
|
||||
if not (Arg.Access in [argDefault,argConst]) then
|
||||
RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(PropArgCount+1),AccessNames[Arg.Access],AccessNames[argConst]],PropEl.WriteAccessor);
|
||||
[IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
|
||||
AccessDescriptions[argConst]],PropEl.WriteAccessor);
|
||||
if Arg.ArgType<>PropType then
|
||||
RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
|
||||
[IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
|
||||
@ -8410,6 +8439,7 @@ begin
|
||||
E.Id:=Id;
|
||||
E.MsgType:=mtError;
|
||||
E.MsgNumber:=MsgNumber;
|
||||
E.MsgPattern:=Fmt;
|
||||
E.PasElement:=ErrorPosEl;
|
||||
E.Args:=FLastMsgArgs;
|
||||
raise E;
|
||||
@ -8473,7 +8503,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; const DescA, DescB: String; ErrorEl: TPasElement);
|
||||
const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
|
||||
|
||||
function GetString(ArgNo: integer): string;
|
||||
begin
|
||||
@ -8487,83 +8517,99 @@ procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
|
||||
begin
|
||||
case MsgNumber of
|
||||
nIllegalTypeConversionTo:
|
||||
RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[DescA,DescB],ErrorEl);
|
||||
RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
|
||||
nIncompatibleTypesGotExpected:
|
||||
RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[DescA,DescB],ErrorEl);
|
||||
RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
|
||||
nIncompatibleTypeArgNo:
|
||||
RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),DescA,DescB],ErrorEl);
|
||||
RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
|
||||
nIncompatibleTypeArgNoVarParamMustMatchExactly:
|
||||
RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
|
||||
[GetString(0),DescA,DescB],ErrorEl);
|
||||
[GetString(0),GotDesc,ExpDesc],ErrorEl);
|
||||
nResultTypeMismatchExpectedButFound:
|
||||
RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[DescA,DescB],ErrorEl);
|
||||
RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
|
||||
nXExpectedButYFound:
|
||||
RaiseMsg(id,MsgNumber,sXExpectedButYFound,[DescA,DescB],ErrorEl);
|
||||
RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
|
||||
else
|
||||
RaiseInternalError(20170329112911);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.RaiseIncompatibleType(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; TypeA, TypeB: TPasType; ErrorEl: TPasElement);
|
||||
const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
|
||||
var
|
||||
DescA, DescB: String;
|
||||
begin
|
||||
DescA:=GetTypeDesc(TypeA);
|
||||
DescB:=GetTypeDesc(TypeB);
|
||||
DescA:=GetTypeDesc(GotType);
|
||||
DescB:=GetTypeDesc(ExpType);
|
||||
if DescA=DescB then
|
||||
begin
|
||||
DescA:=GetTypeDesc(TypeA,true);
|
||||
DescB:=GetTypeDesc(TypeB,true);
|
||||
DescA:=GetTypeDesc(GotType,true);
|
||||
DescB:=GetTypeDesc(ExpType,true);
|
||||
end;
|
||||
RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
|
||||
const Args: array of const; const TypeA, TypeB: TPasResolverResult;
|
||||
const Args: array of const; const GotType, ExpType: TPasResolverResult;
|
||||
ErrorEl: TPasElement);
|
||||
var
|
||||
DescA, DescB: String;
|
||||
begin
|
||||
if TypeA.BaseType<>TypeB.BaseType then
|
||||
begin
|
||||
if TypeA.BaseType=btContext then
|
||||
DescA:=GetTypeDesc(TypeA.TypeEl)
|
||||
else
|
||||
DescA:=BaseTypeNames[TypeA.BaseType];
|
||||
if TypeB.BaseType=btContext then
|
||||
DescB:=GetTypeDesc(TypeB.TypeEl)
|
||||
else
|
||||
DescB:=BaseTypeNames[TypeB.BaseType];
|
||||
if DescA=DescB then
|
||||
|
||||
function GetTypeDsc(const R: TPasResolverResult; AddPath: boolean = false): string;
|
||||
begin
|
||||
Result:=GetTypeDesc(R.TypeEl,AddPath);
|
||||
if R.IdentEl=R.TypeEl then
|
||||
begin
|
||||
if TypeA.BaseType=btContext then
|
||||
DescA:=GetTypeDesc(TypeA.TypeEl,true);
|
||||
if TypeB.BaseType=btContext then
|
||||
DescB:=GetTypeDesc(TypeB.TypeEl,true);
|
||||
if R.TypeEl.ElementTypeName<>'' then
|
||||
Result:=R.TypeEl.ElementTypeName+' '+Result
|
||||
else
|
||||
Result:='type '+Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetBaseDecs(const R: TPasResolverResult; AddPath: boolean = false): string;
|
||||
begin
|
||||
if R.BaseType=btContext then
|
||||
Result:=GetTypeDsc(R,AddPath)
|
||||
else
|
||||
Result:=BaseTypeNames[R.BaseType];
|
||||
end;
|
||||
|
||||
var
|
||||
GotDesc, ExpDesc: String;
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDesc(GotType),'} Expected={',GetResolverResultDesc(ExpType),'}');
|
||||
{$ENDIF}
|
||||
if GotType.BaseType<>ExpType.BaseType then
|
||||
begin
|
||||
GotDesc:=GetBaseDecs(GotType);
|
||||
ExpDesc:=GetBaseDecs(ExpType);
|
||||
if GotDesc=ExpDesc then
|
||||
begin
|
||||
GotDesc:=GetBaseDecs(GotType,true);
|
||||
ExpDesc:=GetBaseDecs(ExpType,true);
|
||||
end;
|
||||
end
|
||||
else if (TypeA.TypeEl<>nil) and (TypeB.TypeEl<>nil) then
|
||||
else if (GotType.TypeEl<>nil) and (ExpType.TypeEl<>nil) then
|
||||
begin
|
||||
DescA:=GetTypeDesc(TypeA.TypeEl);
|
||||
DescB:=GetTypeDesc(TypeB.TypeEl);
|
||||
if DescA=DescB then
|
||||
GotDesc:=GetTypeDsc(GotType);
|
||||
ExpDesc:=GetTypeDsc(ExpType);
|
||||
if GotDesc=ExpDesc then
|
||||
begin
|
||||
DescA:=GetTypeDesc(TypeA.TypeEl,true);
|
||||
DescB:=GetTypeDesc(TypeB.TypeEl,true);
|
||||
GotDesc:=GetTypeDsc(GotType,true);
|
||||
ExpDesc:=GetTypeDsc(ExpType,true);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
DescA:=GetResolverResultDescription(TypeA,true);
|
||||
DescB:=GetResolverResultDescription(TypeA,true);
|
||||
if DescA=DescB then
|
||||
GotDesc:=GetResolverResultDescription(GotType,true);
|
||||
ExpDesc:=GetResolverResultDescription(ExpType,true);
|
||||
if GotDesc=ExpDesc then
|
||||
begin
|
||||
DescA:=GetResolverResultDescription(TypeA,false);
|
||||
DescB:=GetResolverResultDescription(TypeA,false);
|
||||
GotDesc:=GetResolverResultDescription(GotType,false);
|
||||
ExpDesc:=GetResolverResultDescription(ExpType,false);
|
||||
end;
|
||||
end;
|
||||
RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
|
||||
RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
|
||||
@ -8783,6 +8829,7 @@ end;
|
||||
function TPasResolver.CheckProcTypeCompatibility(Proc1,
|
||||
Proc2: TPasProcedureType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
|
||||
): boolean;
|
||||
// if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
|
||||
|
||||
function ModifierError(const Modifier: string): boolean;
|
||||
begin
|
||||
@ -8796,12 +8843,13 @@ var
|
||||
ProcArgs1, ProcArgs2: TFPList;
|
||||
i: Integer;
|
||||
Result1Resolved, Result2Resolved: TPasResolverResult;
|
||||
ExpectedArg, ActualArg: TPasArgument;
|
||||
begin
|
||||
Result:=false;
|
||||
if Proc1.ClassType<>Proc2.ClassType then
|
||||
begin
|
||||
if RaiseOnIncompatible then
|
||||
RaiseXExpectedButYFound(20170402112353,Proc1.TypeName,Proc2.TypeName,ErrorEl);
|
||||
RaiseXExpectedButYFound(20170402112353,Proc1.ElementTypeName,Proc2.ElementTypeName,ErrorEl);
|
||||
exit;
|
||||
end;
|
||||
if Proc1.IsNested<>Proc2.IsNested then
|
||||
@ -8830,16 +8878,29 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.CheckProcAssignCompatibility ',i,'/',ProcArgs1.Count);
|
||||
{$ENDIF}
|
||||
if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i])) then
|
||||
ExpectedArg:=TPasArgument(ProcArgs1[i]);
|
||||
ActualArg:=TPasArgument(ProcArgs2[i]);
|
||||
if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
|
||||
begin
|
||||
if RaiseOnIncompatible then
|
||||
begin
|
||||
if ExpectedArg.Access<>ActualArg.Access then
|
||||
RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
|
||||
AccessDescriptions[ExpectedArg.Access]],
|
||||
ErrorEl);
|
||||
RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
|
||||
[IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if Proc1 is TPasFunctionType then
|
||||
begin
|
||||
ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
|
||||
ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
|
||||
if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
|
||||
or (Result1Resolved.TypeEl=nil)
|
||||
or (Result1Resolved.TypeEl<>Result2Resolved.TypeEl) then
|
||||
or not IsSameType(Result1Resolved.TypeEl,Result2Resolved.TypeEl) then
|
||||
begin
|
||||
if RaiseOnIncompatible then
|
||||
RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
|
||||
@ -8966,6 +9027,9 @@ begin
|
||||
|
||||
Handled:=false;
|
||||
Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
|
||||
if Handled and (Result>=cExact) and (Result<cIncompatible) then
|
||||
exit;
|
||||
|
||||
if not Handled then
|
||||
begin
|
||||
if LHS.TypeEl=nil then
|
||||
@ -9062,10 +9126,10 @@ begin
|
||||
else if (LHS.BaseType=btContext) and (LHS.TypeEl is TPasArrayType) then
|
||||
Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
|
||||
end;
|
||||
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
|
||||
{$ENDIF}
|
||||
|
||||
if (Result>=0) and (Result<cIncompatible) then
|
||||
begin
|
||||
// type fits -> check readable
|
||||
@ -9467,6 +9531,7 @@ var
|
||||
RTypeEl, LTypeEl: TPasType;
|
||||
SrcResolved, DstResolved: TPasResolverResult;
|
||||
LArray, RArray: TPasArrayType;
|
||||
|
||||
function RaiseIncompatType: integer;
|
||||
begin
|
||||
if not RaiseOnIncompatible then exit(cIncompatible);
|
||||
@ -9529,14 +9594,23 @@ begin
|
||||
else if LTypeEl is TPasProcedureType then
|
||||
begin
|
||||
if RHS.BaseType=btNil then
|
||||
Result:=cExact
|
||||
else if (LTypeEl.ClassType=RTypeEl.ClassType)
|
||||
exit(cExact);
|
||||
writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RHS.BaseType=',BaseTypeNames[RHS.BaseType],' RTypeEl=',GetObjName(RTypeEl),' RHS.IdentEl=',GetObjName(RHS.IdentEl),' RHS.ExprEl=',GetObjName(RHS.ExprEl),' rrfReadable=',rrfReadable in RHS.Flags);
|
||||
if (LTypeEl.ClassType=RTypeEl.ClassType)
|
||||
and (rrfReadable in RHS.Flags) then
|
||||
begin
|
||||
// e.g. ProcVar1:=ProcVar2
|
||||
writeln('AAA2 TPasResolver.CheckAssignCompatibilityUserType ');
|
||||
if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
|
||||
ErrorEl,RaiseOnIncompatible) then
|
||||
Result:=cExact;
|
||||
exit(cExact);
|
||||
writeln('AAA3 TPasResolver.CheckAssignCompatibilityUserType ');
|
||||
end;
|
||||
if RaiseOnIncompatible then
|
||||
begin
|
||||
if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
|
||||
RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
|
||||
[RTypeEl.ElementTypeName,LTypeEl.ElementTypeName],ErrorEl);
|
||||
end;
|
||||
end
|
||||
else if LTypeEl.ClassType=TPasArrayType then
|
||||
@ -9927,9 +10001,10 @@ begin
|
||||
if FromResolved.BaseType=btNil then
|
||||
Result:=cExact
|
||||
else if (FromResolved.BaseType=btContext)
|
||||
and (FromResolved.TypeEl.ClassType=TPasClassType)
|
||||
and (not (FromResolved.IdentEl is TPasType)) then
|
||||
and (FromResolved.TypeEl.ClassType=TPasClassType) then
|
||||
begin
|
||||
if (FromResolved.IdentEl is TPasType) then
|
||||
RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
|
||||
// type cast upwards or downwards
|
||||
Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
|
||||
if Result=cIncompatible then
|
||||
@ -9943,9 +10018,10 @@ begin
|
||||
//writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.TypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
|
||||
if (FromResolved.BaseType=btContext) then
|
||||
begin
|
||||
if (FromResolved.TypeEl.ClassType=TPasClassOfType)
|
||||
and (not (FromResolved.IdentEl is TPasType)) then
|
||||
if (FromResolved.TypeEl.ClassType=TPasClassOfType) then
|
||||
begin
|
||||
if (FromResolved.IdentEl is TPasType) then
|
||||
RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
|
||||
// type cast classof(classof-var) upwards or downwards
|
||||
ToClassType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromClassType:=TPasClassOfType(FromResolved.TypeEl).DestType;
|
||||
@ -9980,6 +10056,12 @@ begin
|
||||
ToClassType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromClassType:=TPasClassType(FromResolved.TypeEl);
|
||||
Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
|
||||
if Result<cIncompatible then exit;
|
||||
end;
|
||||
if RaiseOnError then
|
||||
begin
|
||||
if FromResolved.IdentEl is TPasType then
|
||||
RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -1350,6 +1350,7 @@ Type
|
||||
|
||||
const
|
||||
AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
|
||||
AccessDescriptions: array[TArgumentAccess] of string[9] = ('default', 'const', 'var', 'out','constref');
|
||||
AllVisibilities: TPasMemberVisibilities =
|
||||
[visDefault, visPrivate, visProtected, visPublic,
|
||||
visPublished, visAutomated];
|
||||
@ -2320,6 +2321,8 @@ begin
|
||||
okSpecialize : Result := SPasTreeSpecializedType;
|
||||
okClassHelper : Result:=SPasClassHelperType;
|
||||
okRecordHelper : Result:=SPasRecordHelperType;
|
||||
else
|
||||
Result:='ObjKind('+IntToStr(ord(ObjKind))+')';
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -715,6 +715,9 @@ end;
|
||||
procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
|
||||
Args: array of const);
|
||||
begin
|
||||
{$IFDEF VerbosePasParser}
|
||||
writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
|
||||
{$ENDIF}
|
||||
SetLastMsg(mtError,MsgNumber,Fmt,Args);
|
||||
raise EParserError.Create(SafeFormat(SParserErrorAtToken,
|
||||
[FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
|
||||
@ -1867,7 +1870,7 @@ begin
|
||||
if (CurToken<>tkBraceClose) then
|
||||
begin
|
||||
x.Release;
|
||||
Exit;
|
||||
CheckToken(tkBraceClose);
|
||||
end;
|
||||
NextToken;
|
||||
// for expressions like (ppdouble)^^;
|
||||
@ -1888,7 +1891,7 @@ begin
|
||||
x:=ParseExpIdent(AParent);
|
||||
end;
|
||||
if not Assigned(x) then
|
||||
Exit;
|
||||
ParseExcSyntaxError;
|
||||
expstack.Add(x);
|
||||
|
||||
for i:=1 to pcount do
|
||||
@ -1921,7 +1924,7 @@ begin
|
||||
PushOper(CurToken);
|
||||
NextToken;
|
||||
end;
|
||||
// Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
|
||||
//Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
|
||||
until NotBinary or isEndOfExp(AllowEqual);
|
||||
|
||||
if not NotBinary then ParseExcExpectedIdentifier;
|
||||
@ -1929,6 +1932,8 @@ begin
|
||||
while opstackTop>=0 do PopAndPushOperator;
|
||||
|
||||
// only 1 expression should be on the stack, at the end of the correct expression
|
||||
if expstack.Count<>1 then
|
||||
ParseExcSyntaxError;
|
||||
if expstack.Count=1 then
|
||||
begin
|
||||
Result:=TPasExpr(expstack[0]);
|
||||
@ -4096,7 +4101,7 @@ begin
|
||||
while True do
|
||||
begin
|
||||
NextToken;
|
||||
// WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
|
||||
WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
|
||||
case CurToken of
|
||||
tkasm:
|
||||
begin
|
||||
@ -4488,8 +4493,10 @@ begin
|
||||
if CloseBlock then break;
|
||||
end else
|
||||
ParseExcSyntaxError;
|
||||
end
|
||||
else
|
||||
end;
|
||||
tkEOF:
|
||||
CheckToken(tkend);
|
||||
tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
|
||||
begin
|
||||
left:=DoParseExpression(CurBlock);
|
||||
case CurToken of
|
||||
@ -4536,6 +4543,8 @@ begin
|
||||
if not (CmdElem is TPasImplLabelMark) then
|
||||
if NewImplElement=nil then NewImplElement:=CmdElem;
|
||||
end;
|
||||
else
|
||||
ParseExcSyntaxError;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2364,8 +2364,12 @@ function TPascalScanner.FetchLine: boolean;
|
||||
begin
|
||||
if CurSourceFile.IsEOF then
|
||||
begin
|
||||
FCurLine := '';
|
||||
TokenStr := nil;
|
||||
if TokenStr<>nil then
|
||||
begin
|
||||
FCurLine := '';
|
||||
TokenStr := nil;
|
||||
inc(FCurRow); // set CurRow to last line+1
|
||||
end;
|
||||
Result := false;
|
||||
end else
|
||||
begin
|
||||
|
||||
@ -388,6 +388,12 @@ type
|
||||
Procedure TestClass_WarnOverrideLowerVisibility;
|
||||
// Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
|
||||
|
||||
// published
|
||||
Procedure TestClass_PublishedVarFail;
|
||||
Procedure TestClass_PublishedClassPropertyFail;
|
||||
Procedure TestClass_PublishedClassFunctionFail;
|
||||
Procedure TestClass_PublishedOverloadFail;
|
||||
|
||||
// external class
|
||||
Procedure TestExternalClass;
|
||||
Procedure TestExternalClass_Descendant;
|
||||
@ -496,6 +502,7 @@ type
|
||||
Procedure TestAssignMethodToProcFail;
|
||||
Procedure TestAssignProcToFunctionFail;
|
||||
Procedure TestAssignProcWrongArgsFail;
|
||||
Procedure TestAssignProcWrongArgAccessFail;
|
||||
Procedure TestProcType_AssignNestedProcFail;
|
||||
Procedure TestArrayOfProc;
|
||||
Procedure TestProcType_Assigned;
|
||||
@ -508,6 +515,7 @@ type
|
||||
Procedure TestProcType_IsNested_AssignProcFail;
|
||||
Procedure TestProcType_AllowNested;
|
||||
Procedure TestProcType_AllowNestedOfObject;
|
||||
Procedure TestProcType_AsArgOtherUnit;
|
||||
end;
|
||||
|
||||
function LinesToStr(Args: array of const): string;
|
||||
@ -1108,6 +1116,14 @@ begin
|
||||
begin
|
||||
AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
|
||||
MsgNumber,E.MsgNumber);
|
||||
if (Msg<>E.Message) and (Msg<>E.MsgPattern) then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
|
||||
{$ENDIF}
|
||||
AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
|
||||
'{'+Msg+'}','{'+E.Message+'}');
|
||||
end;
|
||||
ok:=true;
|
||||
end;
|
||||
end;
|
||||
@ -1899,7 +1915,7 @@ begin
|
||||
Add('var a: longint;');
|
||||
Add('var a: string;');
|
||||
Add('begin');
|
||||
CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
|
||||
CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestVarInitConst;
|
||||
@ -1984,7 +2000,7 @@ begin
|
||||
Add(' i: string;');
|
||||
Add('begin');
|
||||
Add(' inc(i);');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',PasResolver.nIncompatibleTypeArgNo);
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "String", expected "integer"',PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestVarExternal;
|
||||
@ -2633,7 +2649,7 @@ begin
|
||||
Add(' v:longint;');
|
||||
Add('begin');
|
||||
Add(' v:=''A'';');
|
||||
CheckResolverException('Incompatible types: got "String" expected "Longint"',
|
||||
CheckResolverException('Incompatible types: got "Char" expected "Longint"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
@ -2839,7 +2855,7 @@ begin
|
||||
Add(' i: longint;');
|
||||
Add('begin');
|
||||
Add(' i:=longint(s);');
|
||||
CheckResolverException('illegal type conversion: string to longint',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastStrToCharFail;
|
||||
@ -2850,7 +2866,7 @@ begin
|
||||
Add(' c: char;');
|
||||
Add('begin');
|
||||
Add(' c:=char(s);');
|
||||
CheckResolverException('illegal type conversion: string to char',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastIntToStrFail;
|
||||
@ -2861,7 +2877,7 @@ begin
|
||||
Add(' i: longint;');
|
||||
Add('begin');
|
||||
Add(' s:=string(i);');
|
||||
CheckResolverException('illegal type conversion: longint to string',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastDoubleToStrFail;
|
||||
@ -2872,7 +2888,7 @@ begin
|
||||
Add(' d: double;');
|
||||
Add('begin');
|
||||
Add(' s:=string(d);');
|
||||
CheckResolverException('illegal type conversion: double to string',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastDoubleToIntFail;
|
||||
@ -2883,7 +2899,7 @@ begin
|
||||
Add(' d: double;');
|
||||
Add('begin');
|
||||
Add(' i:=longint(d);');
|
||||
CheckResolverException('illegal type conversion: double to longint',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastDoubleToBoolFail;
|
||||
@ -2894,7 +2910,7 @@ begin
|
||||
Add(' d: double;');
|
||||
Add('begin');
|
||||
Add(' b:=longint(d);');
|
||||
CheckResolverException('illegal type conversion: double to boolean',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestTypeCastBooleanToDoubleFail;
|
||||
@ -2905,7 +2921,7 @@ begin
|
||||
Add(' d: double;');
|
||||
Add('begin');
|
||||
Add(' d:=double(b);');
|
||||
CheckResolverException('illegal type conversion: boolean to double',PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException(sIllegalTypeConversionTo,PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestHighLow;
|
||||
@ -3054,7 +3070,7 @@ begin
|
||||
Add(' except');
|
||||
Add(' on longint do ;');
|
||||
Add(' end;');
|
||||
CheckResolverException('class expected but longint found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('class expected, but Longint found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRaiseNonVarFail;
|
||||
@ -3063,7 +3079,7 @@ begin
|
||||
Add('type TObject = class end;');
|
||||
Add('begin');
|
||||
Add(' raise TObject;');
|
||||
CheckResolverException('var expected but type found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('variable expected, but class found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRaiseNonClassFail;
|
||||
@ -3073,7 +3089,7 @@ begin
|
||||
Add(' E: longint;');
|
||||
Add('begin');
|
||||
Add(' raise E;');
|
||||
CheckResolverException('class expected but longint found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('class expected, but Longint found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRaiseDescendant;
|
||||
@ -3158,7 +3174,7 @@ begin
|
||||
Add('begin');
|
||||
Add(' repeat');
|
||||
Add(' until 3;');
|
||||
CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestWhileDoNonBoolFail;
|
||||
@ -3166,7 +3182,7 @@ begin
|
||||
StartProgram(false);
|
||||
Add('begin');
|
||||
Add(' while 3 do ;');
|
||||
CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestIfThenNonBoolFail;
|
||||
@ -3174,7 +3190,7 @@ begin
|
||||
StartProgram(false);
|
||||
Add('begin');
|
||||
Add(' if 3 then ;');
|
||||
CheckResolverException('boolean expected but longint found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Boolean expected, but Longint found',PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestForLoopVarNonVarFail;
|
||||
@ -3183,7 +3199,7 @@ begin
|
||||
Add('const i = 3;');
|
||||
Add('begin');
|
||||
Add(' for i:=1 to 2 do ;');
|
||||
CheckResolverException('variable identifier expected',nVariableIdentifierExpected);
|
||||
CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestForLoopStartIncompFail;
|
||||
@ -3251,7 +3267,7 @@ begin
|
||||
Add(' case longint of');
|
||||
Add(' 1: ;');
|
||||
Add(' end;');
|
||||
CheckResolverException('const expression expected, but Longint found',
|
||||
CheckResolverException('ordinal expression expected, but Longint found',
|
||||
nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
@ -3445,7 +3461,7 @@ begin
|
||||
Add('begin');
|
||||
Add(' if j1=0 then ;');
|
||||
Add(' if i2=0 then ;');
|
||||
CheckResolverException('identifier not found "i"',nIdentifierNotFound);
|
||||
CheckResolverException('identifier not found "i2"',nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcParam;
|
||||
@ -3649,7 +3665,7 @@ begin
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
|
||||
CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestNestedProc;
|
||||
@ -3698,7 +3714,7 @@ begin
|
||||
StartProgram(false);
|
||||
Add('procedure FuncA(i: longint); forward;');
|
||||
Add('begin');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestNestedForwardProc;
|
||||
@ -3730,7 +3746,7 @@ begin
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestForwardProcFuncMismatch;
|
||||
@ -3752,7 +3768,8 @@ begin
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Result type mismatch',PasResolver.nResultTypeMismatchExpectedButFound);
|
||||
CheckResolverException('Result type mismatch, expected Longint, but found String',
|
||||
PasResolver.nResultTypeMismatchExpectedButFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnitIntfProc;
|
||||
@ -3777,7 +3794,7 @@ begin
|
||||
Add('procedure {#A_forward}FuncA(i: longint);');
|
||||
Add('implementation');
|
||||
Add('initialization');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnitIntfMismatchArgName;
|
||||
@ -3789,7 +3806,7 @@ begin
|
||||
Add('procedure {#A}ProcA(j: longint);');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
CheckResolverException('function header "ProcA" doesn''t match forward : var name changes',
|
||||
CheckResolverException('function header "ProcA" doesn''t match forward : var name changes i => j',
|
||||
PasResolver.nFunctionHeaderMismatchForwardVarName);
|
||||
end;
|
||||
|
||||
@ -3803,7 +3820,7 @@ begin
|
||||
Add('procedure {#A_Impl}ProcA(i: longint);');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
CheckResolverException('Duplicate identifier',PasResolver.nDuplicateIdentifier);
|
||||
CheckResolverException(sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcCallMissingParams;
|
||||
@ -3814,7 +3831,7 @@ begin
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
Add(' Proc1;');
|
||||
CheckResolverException('Wrong number of parameters for call to "Proc1"',
|
||||
CheckResolverException('Wrong number of parameters specified for call to "Proc1"',
|
||||
PasResolver.nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
@ -3858,7 +3875,7 @@ begin
|
||||
StartProgram(false);
|
||||
Add('begin');
|
||||
Add(' length;');
|
||||
CheckResolverException('Wrong number of parameters for call to "length"',
|
||||
CheckResolverException('Wrong number of parameters specified for call to "function Length(const String or Array): sizeint"',
|
||||
PasResolver.nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
@ -3889,7 +3906,8 @@ begin
|
||||
Add('var {#i}i: longint;');
|
||||
Add('begin');
|
||||
Add(' {@i}i:={@P}P();');
|
||||
CheckResolverException('{Incompatible types: got "Procedure/Function" expected "Longint"',PasResolver.nIncompatibleTypesGotExpected);
|
||||
CheckResolverException('Incompatible types: got "Procedure/Function" expected "Longint"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestFunctionResultInCondition;
|
||||
@ -4351,7 +4369,7 @@ begin
|
||||
Add('var');
|
||||
Add(' v: TClassB;');
|
||||
Add('begin');
|
||||
CheckResolverException('Forward class not resolved raises correct error',
|
||||
CheckResolverException(sForwardTypeNotResolved,
|
||||
nForwardTypeNotResolved);
|
||||
end;
|
||||
|
||||
@ -4415,7 +4433,7 @@ begin
|
||||
Add(' procedure ProcA;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodUnresolvedUnit;
|
||||
@ -4429,7 +4447,7 @@ begin
|
||||
Add(' procedure ProcA;');
|
||||
Add(' end;');
|
||||
Add('implementation');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodAbstract;
|
||||
@ -4451,7 +4469,7 @@ begin
|
||||
Add(' procedure ProcA; abstract;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('abstract without virtual',PasResolver.nInvalidXModifiersY);
|
||||
CheckResolverException('Invalid procedure modifier abstract without virtual',PasResolver.nInvalidXModifierY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodAbstractHasBodyFail;
|
||||
@ -4465,7 +4483,7 @@ begin
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('abstract must not have implementation',
|
||||
CheckResolverException(sAbstractMethodsMustNotHaveImplementation,
|
||||
PasResolver.nAbstractMethodsMustNotHaveImplementation);
|
||||
end;
|
||||
|
||||
@ -4480,7 +4498,7 @@ begin
|
||||
Add(' procedure ProcA;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('forward proc not resolved',PasResolver.nForwardProcNotResolved);
|
||||
CheckResolverException(sForwardProcNotResolved,PasResolver.nForwardProcNotResolved);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_ProcFuncMismatch;
|
||||
@ -4534,7 +4552,7 @@ begin
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Duplicate identifier',PasResolver.nDuplicateIdentifier);
|
||||
CheckResolverException(PasResolver.sDuplicateIdentifier,PasResolver.nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_MethodOverride;
|
||||
@ -4953,7 +4971,7 @@ begin
|
||||
Add(' {#v}{=A}v: TClassA;');
|
||||
Add('begin');
|
||||
Add(' if {@v}v is {@TObj}TObject then;');
|
||||
CheckResolverException('types are not related',PasResolver.nTypesAreNotRelated);
|
||||
CheckResolverException(sTypesAreNotRelated,PasResolver.nTypesAreNotRelated);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_OperatorIsOnNonTypeFail;
|
||||
@ -4969,7 +4987,7 @@ begin
|
||||
Add(' {#v}{=A}v: TClassA;');
|
||||
Add('begin');
|
||||
Add(' if {@o}o is {@v}v then;');
|
||||
CheckResolverException('class type expected, but got variable',
|
||||
CheckResolverException('class type expected, but class found',
|
||||
PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
@ -4986,7 +5004,7 @@ begin
|
||||
Add(' {#v}{=A}v: TClassA;');
|
||||
Add('begin');
|
||||
Add(' {@o}o:={@v}v as {@TObj}TObject;');
|
||||
CheckResolverException('types are not related',PasResolver.nTypesAreNotRelated);
|
||||
CheckResolverException(sTypesAreNotRelated,PasResolver.nTypesAreNotRelated);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_OperatorAsOnNonTypeFail;
|
||||
@ -5002,7 +5020,7 @@ begin
|
||||
Add(' {#v}{=A}v: TClassA;');
|
||||
Add('begin');
|
||||
Add(' {@o}o:={@v}v as {@o}o;');
|
||||
CheckResolverException('class expected, but o found" number',
|
||||
CheckResolverException('class expected, but o found',
|
||||
PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
@ -5096,7 +5114,7 @@ begin
|
||||
Add(' {#vb}{=B}vb: TClassB;');
|
||||
Add('begin');
|
||||
Add(' {@vb}vb:=TClassB({@va}va);');
|
||||
CheckResolverException('Illegal type conversion: "class TClassA" to "TClassB"',
|
||||
CheckResolverException('Illegal type conversion: "TClassA" to "class TClassB"',
|
||||
PasResolver.nIllegalTypeConversionTo);
|
||||
end;
|
||||
|
||||
@ -5200,7 +5218,8 @@ begin
|
||||
Add(' end;');
|
||||
Add('procedure TObject.ProcA; begin end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Invalid procedure modifiers static',PasResolver.nInvalidXModifiersY);
|
||||
CheckResolverException('Invalid procedure modifier static',
|
||||
PasResolver.nInvalidXModifierY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_SelfInStaticFail;
|
||||
@ -5813,7 +5832,7 @@ begin
|
||||
Add(' TNop = class(TObject)');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Cannot create a decscendant of the sealed class "TObject"',
|
||||
CheckResolverException(sCannotCreateADescendantOfTheSealedClass,
|
||||
nCannotCreateADescendantOfTheSealedClass);
|
||||
end;
|
||||
|
||||
@ -5868,6 +5887,60 @@ begin
|
||||
'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)',true);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PublishedVarFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' published');
|
||||
Add(' Id: longint;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PublishedClassPropertyFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' class var FA: longint;');
|
||||
Add(' published');
|
||||
Add(' class property A: longint read FA;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Invalid published property modifier "class"',
|
||||
nInvalidXModifierY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PublishedClassFunctionFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' published');
|
||||
Add(' class procedure DoIt;');
|
||||
Add(' end;');
|
||||
Add('class procedure TObject.DoIt; begin end;');
|
||||
Add('begin');
|
||||
CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_PublishedOverloadFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' published');
|
||||
Add(' procedure DoIt;');
|
||||
Add(' procedure DoIt(i: longint);');
|
||||
Add(' end;');
|
||||
Add('procedure TObject.DoIt; begin end;');
|
||||
Add('procedure TObject.DoIt(i: longint); begin end;');
|
||||
Add('begin');
|
||||
CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestExternalClass;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -6207,8 +6280,8 @@ begin
|
||||
Add(' if TObject(Self)=nil then ;');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Illegal type conversion: "class TObject" to "TObject"',
|
||||
PasResolver.nIllegalTypeConversionTo);
|
||||
CheckResolverException('Cannot type cast a type',
|
||||
PasResolver.nCannotTypecastAType);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_ClassMembers;
|
||||
@ -6444,7 +6517,7 @@ begin
|
||||
Add(' FB: longint;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Identifier not found',PasResolver.nIdentifierNotFound);
|
||||
CheckResolverException('identifier not found "FB"',PasResolver.nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
|
||||
@ -6481,7 +6554,8 @@ begin
|
||||
Add(' property B: longint read GetB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('function result longint expected, but function result string found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('function result Longint expected, but String found',
|
||||
PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorFuncWrongArgCount;
|
||||
@ -6489,11 +6563,12 @@ begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' function GetB(i: longint): string;');
|
||||
Add(' function GetB(i: longint): longint;');
|
||||
Add(' property B: longint read GetB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('function arg count 0 expected, but 1 found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('Wrong number of parameters specified for call to "GetB"',
|
||||
PasResolver.nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyReadAccessorFunc;
|
||||
@ -6561,7 +6636,7 @@ begin
|
||||
Add(' property B: longint write SetB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "var ", expected "const "',
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "var", expected "const"',
|
||||
PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
@ -6625,7 +6700,8 @@ begin
|
||||
Add(' property B;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('no property found to override',PasResolver.nNoPropertyFoundToOverride);
|
||||
CheckResolverException(PasResolver.sNoPropertyFoundToOverride,
|
||||
PasResolver.nNoPropertyFoundToOverride);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyStoredAccessorProcNotFunc;
|
||||
@ -6651,7 +6727,8 @@ begin
|
||||
Add(' property B: longint read FB stored GetB;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
CheckResolverException('function result longint expected, but function result string found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('function: boolean expected, but function:String found',
|
||||
PasResolver.nXExpectedButYFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyStoredAccessorFuncWrongArgCount;
|
||||
@ -6779,7 +6856,7 @@ begin
|
||||
Add('var Obj: tobject;');
|
||||
Add('begin');
|
||||
Add(' obj.Items[3]:=4;');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "Index:String"',
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
|
||||
PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
@ -7293,7 +7370,7 @@ begin
|
||||
Add(' a: array[TEnum] of longint;');
|
||||
Add('begin');
|
||||
Add(' SetLength(a,1);');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "array[] of Longint", expected "string or dynamic array variable',
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "static array[] of Longint", expected "string or dynamic array variable"',
|
||||
nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
@ -7306,7 +7383,7 @@ begin
|
||||
Add(' a: array[TEnum] of longint;');
|
||||
Add('begin');
|
||||
Add(' a:=nil;');
|
||||
CheckResolverException('Incompatible types: got "nil" expected "array type"',
|
||||
CheckResolverException('Incompatible types: got "Nil" expected "array type"',
|
||||
nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
@ -7425,7 +7502,7 @@ begin
|
||||
Add(' B: TArrayStr;');
|
||||
Add('begin');
|
||||
Add(' A:=Copy(B);');
|
||||
CheckResolverException('Incompatible types: got "array of integer" expected "array of String"',
|
||||
CheckResolverException('Incompatible types: got "TArrayStr" expected "TArrayInt"',
|
||||
nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
@ -7864,7 +7941,8 @@ begin
|
||||
Add('var p: TFuncInt;');
|
||||
Add('begin');
|
||||
Add(' p:=@ProcA;');
|
||||
CheckResolverException('Incompatible types: got "procedure(Longint)" expected "p:function(Longint)"',
|
||||
CheckResolverException(
|
||||
'Incompatible types: got "procedure type" expected "function type"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
@ -7878,8 +7956,22 @@ begin
|
||||
Add('var p: TProcInt;');
|
||||
Add('begin');
|
||||
Add(' p:=@ProcA;');
|
||||
CheckResolverException('Incompatible types: got "procedure(String)" expected "p:procedure(Longint)"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
|
||||
PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAssignProcWrongArgAccessFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TProcInt = procedure(i: longint);');
|
||||
Add('procedure ProcA(const i: longint);');
|
||||
Add('begin end;');
|
||||
Add('var p: TProcInt;');
|
||||
Add('begin');
|
||||
Add(' p:=@ProcA;');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "access modifier const", expected "default"',
|
||||
PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcType_AssignNestedProcFail;
|
||||
@ -7985,7 +8077,8 @@ begin
|
||||
Add(' Button1: TButton;');
|
||||
Add('begin');
|
||||
Add(' Button1.OnClick := App.BtnClickHandler;');
|
||||
CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
|
||||
CheckResolverException(
|
||||
'Wrong number of parameters specified for call to "BtnClickHandler"',
|
||||
nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
@ -8008,7 +8101,8 @@ begin
|
||||
Add(' Button1: TButton;');
|
||||
Add('begin');
|
||||
Add(' Button1.OnClick := App.BtnClickHandler();');
|
||||
CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
|
||||
CheckResolverException(
|
||||
'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
|
||||
nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
@ -8031,7 +8125,8 @@ begin
|
||||
Add(' Button1: TButton;');
|
||||
Add('begin');
|
||||
Add(' Button1.OnClick := @App.BtnClickHandler();');
|
||||
CheckResolverException('Wrong number of parameters specified for call to "BtnClickHandler"',
|
||||
CheckResolverException(
|
||||
'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of object"',
|
||||
nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
@ -8092,7 +8187,7 @@ begin
|
||||
Add('var p: TNestedProc;');
|
||||
Add('begin');
|
||||
Add(' p:=@DoIt;');
|
||||
CheckResolverException('foo',nXModifierMismatchY);
|
||||
CheckResolverException('procedure type modifier "is nested" mismatch',nXModifierMismatchY);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcType_AllowNested;
|
||||
@ -8170,6 +8265,32 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcType_AsArgOtherUnit;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pas',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' JSInteger = longint;',
|
||||
' TObject = class;',
|
||||
' TJSArrayCallBack = function (element : JSInteger) : Boolean;',
|
||||
' TObject = class',
|
||||
' public',
|
||||
' procedure forEach(const aCallBack : TJSArrayCallBack); virtual; abstract;',
|
||||
' end;',
|
||||
'']),
|
||||
'');
|
||||
StartProgram(true);
|
||||
Add('uses unit2;');
|
||||
Add('function showElement(el : JSInteger) : boolean ;');
|
||||
Add('begin');
|
||||
Add(' result:=true;');
|
||||
Add('end;');
|
||||
Add('var a: TObject;');
|
||||
Add('begin');
|
||||
Add(' a.forEach(@ShowElement);');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestResolver]);
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user