mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 15:10:40 +02:00
* Patch from Mattias Gaertner:
- intrinsics:
function concat(array1,array2,...): array
function copy(array): array, copy(a,start), copy(a,start,end)
insert(item; var array; index: integer)
delete(var array; start, count: integer)
- unified type mismatch errors and report types with paths if needed
git-svn-id: trunk@35692 -
This commit is contained in:
michael
parent
f2aebcd595
commit
ba7d698b1d
@ -103,12 +103,16 @@ Works:
|
||||
- arrays TPasArrayType
|
||||
- TPasEnumType, char, integer, range
|
||||
- low, high, length, setlength, assigned
|
||||
- function concat(array1,array2,...): array
|
||||
- function copy(array): array, copy(a,start), copy(a,start,end)
|
||||
- insert(item; var array; index: integer)
|
||||
- delete(var array; start, count: integer)
|
||||
- element
|
||||
- multi dimensional
|
||||
- const
|
||||
- open array, override, pass array literal, pass var
|
||||
- check if var initexpr fits vartype: var a: type = expr;
|
||||
- built-in functions high, low for range types, enums and arrays
|
||||
- built-in functions high, low for range types
|
||||
- procedure type
|
||||
- method type
|
||||
- function without params: mark if call or address, rrfImplicitCallWithoutParams
|
||||
@ -446,7 +450,11 @@ type
|
||||
bfPred,
|
||||
bfSucc,
|
||||
bfStrProc,
|
||||
bfStrFunc
|
||||
bfStrFunc,
|
||||
bfConcatArray,
|
||||
bfCopyArray,
|
||||
bfInsertArray,
|
||||
bfDeleteArray
|
||||
);
|
||||
TResolverBuiltInProcs = set of TResolverBuiltInProc;
|
||||
const
|
||||
@ -469,7 +477,11 @@ const
|
||||
'Pred',
|
||||
'Succ',
|
||||
'Str',
|
||||
'Str'
|
||||
'Str',
|
||||
'Concat',
|
||||
'Copy',
|
||||
'Insert',
|
||||
'Delete'
|
||||
);
|
||||
bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
|
||||
|
||||
@ -1080,12 +1092,19 @@ type
|
||||
function IsCharLiteral(const Value: string): boolean; virtual;
|
||||
function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
|
||||
MinCount: integer; RaiseOnError: boolean): boolean;
|
||||
function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
|
||||
MaxCount: integer; RaiseOnError: boolean): integer;
|
||||
function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
|
||||
const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
|
||||
// custom types (added by descendant resolvers)
|
||||
function CheckTypeCastCustomBaseType(const TypeResolved: TPasResolverResult;
|
||||
Param: TPasExpr; const ParamResolved: TPasResolverResult): integer; virtual;
|
||||
function CheckAssignCompatibilityCustomBaseType(
|
||||
const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
|
||||
RaiseOnIncompatible: boolean): integer; virtual;
|
||||
function CheckEqualCompatibilityCustomType(
|
||||
const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
|
||||
RaiseOnIncompatible: boolean): integer; virtual;
|
||||
protected
|
||||
// built-in functions
|
||||
function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
@ -1141,6 +1160,22 @@ type
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure BI_StrFunc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure BI_CopyArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr); virtual;
|
||||
function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr); virtual;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -1243,7 +1278,7 @@ type
|
||||
function CheckConstArrayCompatibility(Params: TParamsExpr;
|
||||
const ArrayResolved: TPasResolverResult; RaiseOnError: boolean;
|
||||
Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil): integer;
|
||||
function CheckEqualCompatibilityCustomType(
|
||||
function CheckEqualCompatibilityUserType(
|
||||
const TypeA, TypeB: TPasResolverResult; ErrorEl: TPasElement;
|
||||
RaiseOnIncompatible: boolean): integer;
|
||||
function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
|
||||
@ -1417,22 +1452,8 @@ begin
|
||||
end
|
||||
else if (C=TPasUnresolvedTypeRef) then
|
||||
Result:=GetName
|
||||
else if C=TPasPointerType then
|
||||
Result:='^'+GetTypeDesc(TPasPointerType(aType).DestType,AddPath)
|
||||
else if (C=TPasAliasType)
|
||||
or (C=TPasTypeAliasType)
|
||||
or (C=TPasClassOfType)
|
||||
or (C=TPasClassType)
|
||||
or (C=TPasRecordType)
|
||||
or (C=TPasEnumType)
|
||||
or (C=TPasSetType) then
|
||||
Result:=GetName
|
||||
else if C=TPasArrayType then
|
||||
Result:='array['+TPasArrayType(aType).IndexRange+'] of '+GetTypeDesc(TPasArrayType(aType).ElType,AddPath)
|
||||
else if aType is TPasProcedureType then
|
||||
Result:=GetProcDesc(TPasProcedureType(aType),false,AddPath)
|
||||
else
|
||||
Result:=aType.ElementTypeName+' '+GetName;
|
||||
Result:=GetName;
|
||||
end;
|
||||
|
||||
function GetTreeDesc(El: TPasElement; Indent: integer): string;
|
||||
@ -3616,8 +3637,8 @@ var
|
||||
while ArgNo<PropEl.Args.Count do
|
||||
begin
|
||||
if ArgNo>=Proc.ProcType.Args.Count then
|
||||
RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
|
||||
[Proc.Name],ErrorEl);
|
||||
RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
|
||||
PropArg:=TPasArgument(PropEl.Args[ArgNo]);
|
||||
ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
|
||||
inc(ArgNo);
|
||||
@ -6352,6 +6373,30 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean): integer;
|
||||
begin
|
||||
if length(Params.Params)>MaxCount then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[MaxCount]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckRaiseTypeArgNo(id: int64; ArgNo: integer;
|
||||
Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
|
||||
RaiseOnError: boolean): integer;
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
|
||||
Result:=cIncompatible;
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckTypeCastCustomBaseType(
|
||||
const TypeResolved: TPasResolverResult; Param: TPasExpr;
|
||||
const ParamResolved: TPasResolverResult): integer;
|
||||
@ -6375,6 +6420,16 @@ begin
|
||||
if RaiseOnIncompatible then ;
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
|
||||
RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
|
||||
): integer;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if LHS.BaseType=RHS.BaseType then;
|
||||
if ErrorEl=nil then;
|
||||
if RaiseOnIncompatible then ;
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_Length_OnGetCallCompatibility(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
// check params of built in proc 'length'
|
||||
@ -6402,21 +6457,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152250,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'string or array'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
|
||||
'string or array',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152251,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -6458,13 +6502,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152254,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'string or dynamic array variable'],
|
||||
Param);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
|
||||
'string or dynamic array variable',RaiseOnError));
|
||||
|
||||
// second param: new length
|
||||
Param:=Params.Params[1];
|
||||
@ -6474,20 +6513,10 @@ begin
|
||||
and (ParamResolved.BaseType in btAllInteger) then
|
||||
Result:=cExact;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152256,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['2',GetTypeDesc(ParamResolved.TypeEl),'integer'],Param);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170329160338,2,Param,ParamResolved,
|
||||
'integer',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>2 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152257,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[2]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
|
||||
@ -6531,11 +6560,8 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDesc(ParamResolved));
|
||||
{$ENDIF}
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152301,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'variable of set of enumtype'],
|
||||
Param);
|
||||
exit(cIncompatible);
|
||||
exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
|
||||
'variable of set of enumtype',RaiseOnError));
|
||||
end;
|
||||
|
||||
// second param: enum
|
||||
@ -6550,15 +6576,7 @@ begin
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
if length(Params.Params)>2 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152304,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[2]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
|
||||
@ -6585,10 +6603,7 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
|
||||
{$ENDIF}
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152308,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
Result:=cIncompatible;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_Continue_OnGetCallCompatibility(
|
||||
@ -6604,10 +6619,7 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
|
||||
{$ENDIF}
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152311,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
Result:=cIncompatible;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
|
||||
@ -6669,22 +6681,12 @@ begin
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152314,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetResolverResultDescription(ParamResolved,true),
|
||||
GetResolverResultDescription(ResultResolved,true)],
|
||||
Param);
|
||||
RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
|
||||
['1'],ParamResolved,ResultResolved,Param);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152316,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_IncDec_OnGetCallCompatibility(
|
||||
@ -6715,13 +6717,7 @@ begin
|
||||
if ParamResolved.BaseType in btAllInteger then
|
||||
Result:=cExact;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152320,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'integer'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
if length(Params.Params)=1 then
|
||||
exit;
|
||||
@ -6736,23 +6732,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152322,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['2',GetTypeDesc(IncrResolved.TypeEl),'integer'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>2 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152324,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[2]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
|
||||
@ -6796,23 +6778,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152329,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'class or array'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152331,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -6842,23 +6810,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170325185321,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'integer'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170325185323,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -6890,23 +6844,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152334,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152335,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -6944,23 +6884,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152338,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'enum or char',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152340,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -7022,23 +6948,9 @@ begin
|
||||
if CheckIsOrdinal(ParamResolved,Param,false) then
|
||||
Result:=cExact;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152343,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'ordinal'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152345,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
|
||||
@ -7105,13 +7017,7 @@ begin
|
||||
Result:=cExact
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170319220517,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),GetTypeDesc(ParamResolved.TypeEl),'boolean, integer, enum value'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
|
||||
if not CheckFormat(Param.format1,1,ParamResolved) then
|
||||
exit(cIncompatible);
|
||||
if not CheckFormat(Param.format2,2,ParamResolved) then
|
||||
@ -7154,23 +7060,9 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170319220806,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'string variable'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
|
||||
|
||||
if length(Params.Params)>2 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152345,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[2]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
|
||||
@ -7198,13 +7090,11 @@ begin
|
||||
if not ParentNeedsExprResult(Params) then
|
||||
begin
|
||||
// not in an expression -> the 'procedure str' is needed, not the 'function str'
|
||||
writeln('AAA1 TPasResolver.BI_StrFunc_OnGetCallCompatibility ',GetObjName(Params.Parent));
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
|
||||
sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
writeln('AAA2 TPasResolver.BI_StrFunc_OnGetCallCompatibility ',GetObjName(Params.Parent));
|
||||
|
||||
// param: string, boolean, integer, enum, class instance
|
||||
for i:=0 to length(Params.Params)-1 do
|
||||
@ -7226,6 +7116,212 @@ begin
|
||||
SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,FBaseTypes[btString],[rrfReadable]);
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
|
||||
exit;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
FirstElTypeResolved:=Default(TPasResolverResult);
|
||||
for i:=0 to length(Params.Params)-1 do
|
||||
begin
|
||||
// all params: array
|
||||
Param:=Params.Params[i];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or (ParamResolved.BaseType<>btContext)
|
||||
or not IsDynArray(ParamResolved.TypeEl) then
|
||||
exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
|
||||
ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
|
||||
Include(ElTypeResolved.Flags,rrfReadable);
|
||||
if i=0 then
|
||||
begin
|
||||
FirstElTypeResolved:=ElTypeResolved;
|
||||
Include(ElTypeResolved.Flags,rrfWritable);
|
||||
end
|
||||
else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
|
||||
Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
|
||||
ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
ComputeElement(Params.Params[0],ResolvedEl,[]);
|
||||
ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
|
||||
exit;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// first param: array
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if (rrfReadable in ParamResolved.Flags)
|
||||
and (ParamResolved.BaseType=btContext)
|
||||
and IsDynArray(ParamResolved.TypeEl) then
|
||||
Result:=cExact;
|
||||
if Result=cIncompatible then
|
||||
exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
|
||||
if length(Params.Params)=1 then
|
||||
exit(cExact);
|
||||
|
||||
// check optional Start index
|
||||
Param:=Params.Params[1];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
|
||||
if length(Params.Params)=2 then
|
||||
exit(cExact);
|
||||
|
||||
// check optional Count
|
||||
Param:=Params.Params[2];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_CopyArray_OnGetCallResult(
|
||||
Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
|
||||
ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
ComputeElement(Params.Params[0],ResolvedEl,[]);
|
||||
ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
// Insert(Item,var Array,Index)
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param, ItemParam: TPasExpr;
|
||||
ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
|
||||
exit;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// check Item
|
||||
ItemParam:=Params.Params[0];
|
||||
ComputeElement(ItemParam,ItemResolved,[]);
|
||||
if not (rrfReadable in ItemResolved.Flags) then
|
||||
exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
|
||||
|
||||
// check Array
|
||||
Param:=Params.Params[1];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not ResolvedElCanBeVarParam(ParamResolved) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170329171514,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
|
||||
exit;
|
||||
end;
|
||||
if (ParamResolved.BaseType<>btContext)
|
||||
or not IsDynArray(ParamResolved.TypeEl) then
|
||||
exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
|
||||
ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
|
||||
if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
|
||||
exit(cIncompatible);
|
||||
|
||||
// check insert Index
|
||||
Param:=Params.Params[2];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
|
||||
Proc: TResElDataBuiltInProc; Params: TParamsExpr);
|
||||
var
|
||||
P: TPasExprArray;
|
||||
begin
|
||||
if Proc=nil then ;
|
||||
P:=Params.Params;
|
||||
FinishParamExpressionAccess(P[0],rraRead);
|
||||
FinishParamExpressionAccess(P[1],rraVarParam);
|
||||
FinishParamExpressionAccess(P[2],rraRead);
|
||||
end;
|
||||
|
||||
function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
// Delete(var Array; Start, Count: integer)
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
|
||||
exit;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// check Array
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not ResolvedElCanBeVarParam(ParamResolved) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170329173421,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
|
||||
exit;
|
||||
end;
|
||||
if (ParamResolved.BaseType<>btContext)
|
||||
or not IsDynArray(ParamResolved.TypeEl) then
|
||||
exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
|
||||
|
||||
// check param Start
|
||||
Param:=Params.Params[1];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
// check param Count
|
||||
Param:=Params.Params[2];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
if not (rrfReadable in ParamResolved.Flags)
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
|
||||
|
||||
Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
|
||||
Proc: TResElDataBuiltInProc; Params: TParamsExpr);
|
||||
var
|
||||
P: TPasExprArray;
|
||||
begin
|
||||
if Proc=nil then ;
|
||||
P:=Params.Params;
|
||||
FinishParamExpressionAccess(P[0],rraVarParam);
|
||||
FinishParamExpressionAccess(P[1],rraRead);
|
||||
FinishParamExpressionAccess(P[2],rraRead);
|
||||
end;
|
||||
|
||||
constructor TPasResolver.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -7816,6 +7912,20 @@ begin
|
||||
if bfStrFunc in TheBaseProcs then
|
||||
AddBuiltInProc('Str','function Str(const var): String',
|
||||
@BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,nil,bfStrFunc);
|
||||
if bfConcatArray in TheBaseProcs then
|
||||
AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
|
||||
@BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,nil,bfConcatArray);
|
||||
if bfCopyArray in TheBaseProcs then
|
||||
AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
|
||||
@BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,nil,bfCopyArray);
|
||||
if bfInsertArray in TheBaseProcs then
|
||||
AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
|
||||
@BI_InsertArray_OnGetCallCompatibility,nil,
|
||||
@BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
|
||||
if bfDeleteArray in TheBaseProcs then
|
||||
AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
|
||||
@BI_DeleteArray_OnGetCallCompatibility,nil,
|
||||
@BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
|
||||
end;
|
||||
|
||||
function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
|
||||
@ -8415,21 +8525,9 @@ begin
|
||||
begin
|
||||
// dynamic array -> needs exactly one integer
|
||||
GetNextParam;
|
||||
if not (ParamResolved.BaseType in btAllInteger) then
|
||||
begin
|
||||
if not RaiseOnError then exit(cIncompatible);
|
||||
RaiseMsg(20170216152417,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),BaseTypeNames[ParamResolved.BaseType],'integer'],
|
||||
Param);
|
||||
end;
|
||||
if not (rrfReadable in ParamResolved.Flags) then
|
||||
begin
|
||||
if not RaiseOnError then exit(cIncompatible);
|
||||
RaiseMsg(20170216152419,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),
|
||||
'integer'],
|
||||
Param);
|
||||
end;
|
||||
if (not (rrfReadable in ParamResolved.Flags))
|
||||
or not (ParamResolved.BaseType in btAllInteger) then
|
||||
exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -8444,10 +8542,8 @@ begin
|
||||
if not (rrfReadable in ParamResolved.Flags) then
|
||||
begin
|
||||
if not RaiseOnError then exit(cIncompatible);
|
||||
RaiseMsg(20170216152421,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),
|
||||
GetResolverResultDescription(RangeResolved,true)],
|
||||
Param);
|
||||
RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
|
||||
end;
|
||||
if (bt in btAllBooleans) and (ParamResolved.BaseType in btAllBooleans) then
|
||||
continue
|
||||
@ -8463,10 +8559,8 @@ begin
|
||||
end;
|
||||
// incompatible
|
||||
if not RaiseOnError then exit(cIncompatible);
|
||||
RaiseMsg(20170216152422,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),
|
||||
GetResolverResultDescription(RangeResolved,true)],
|
||||
Param);
|
||||
RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
|
||||
[IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
|
||||
end;
|
||||
end;
|
||||
if ArgNo=length(Params.Params) then exit(cExact);
|
||||
@ -8775,7 +8869,7 @@ begin
|
||||
|
||||
// create error messages
|
||||
RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
|
||||
[],LHS,RHS,ErrorEl);
|
||||
[],RHS,LHS,ErrorEl);
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
|
||||
@ -8824,10 +8918,18 @@ begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.CheckEqualCompatibility LHS=',GetResolverResultDesc(LHS),' RHS=',GetResolverResultDesc(RHS));
|
||||
{$ENDIF}
|
||||
if LHS.BaseType=RHS.BaseType then
|
||||
if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
|
||||
begin
|
||||
Result:=CheckEqualCompatibilityCustomType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
|
||||
if (Result=cIncompatible) and RaiseOnIncompatible then
|
||||
RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
|
||||
[],RHS,LHS,ErrorEl);
|
||||
exit;
|
||||
end
|
||||
else if LHS.BaseType=RHS.BaseType then
|
||||
begin
|
||||
if LHS.BaseType=btContext then
|
||||
exit(CheckEqualCompatibilityCustomType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
|
||||
exit(CheckEqualCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
|
||||
else
|
||||
exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
|
||||
end
|
||||
@ -9095,9 +9197,8 @@ begin
|
||||
|
||||
Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
|
||||
if (Result=cIncompatible) and RaiseOnError then
|
||||
RaiseMsg(20170216152454,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
[IntToStr(ParamNo+1),GetResolverResultDescription(ExprResolved,true),
|
||||
GetResolverResultDescription(ParamResolved,true)],Expr);
|
||||
RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
|
||||
[IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
|
||||
@ -9368,7 +9469,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckEqualCompatibilityCustomType(const TypeA,
|
||||
function TPasResolver.CheckEqualCompatibilityUserType(const TypeA,
|
||||
TypeB: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
|
||||
): integer;
|
||||
var
|
||||
|
||||
@ -268,6 +268,7 @@ type
|
||||
Procedure TestProcParam;
|
||||
Procedure TestProcParamAccess;
|
||||
Procedure TestFunctionResult;
|
||||
Procedure TestProcedureResultFail;
|
||||
Procedure TestProcOverload;
|
||||
Procedure TestProcOverloadWithBaseTypes;
|
||||
Procedure TestProcOverloadWithClassTypes;
|
||||
@ -467,6 +468,10 @@ type
|
||||
Procedure TestArray_OpenArrayOfString;
|
||||
Procedure TestArray_OpenArrayOfString_IntFail;
|
||||
Procedure TestArray_OpenArrayOverride;
|
||||
Procedure TestArray_CopyConcat;
|
||||
Procedure TestArray_CopyMismatchFail;
|
||||
Procedure TestArray_InsertDelete;
|
||||
Procedure TestArray_InsertItemMismatchFail;
|
||||
|
||||
// procedure types
|
||||
Procedure TestProcTypesAssignObjFPC;
|
||||
@ -3451,6 +3456,15 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcedureResultFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure A: longint; begin end;');
|
||||
Add('begin');
|
||||
CheckParserException('Expected ";" at token ":" in file afile.pp at line 2 column 12',
|
||||
nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcOverload;
|
||||
var
|
||||
El: TPasElement;
|
||||
@ -6005,13 +6019,13 @@ begin
|
||||
Add(' TObject = class');
|
||||
Add(' class var FA: longint;');
|
||||
Add(' class function GetA: longint; static;');
|
||||
Add(' class procedure SetA(Value: longint): longint; static;');
|
||||
Add(' class procedure SetA(Value: longint); static;');
|
||||
Add(' class property A1: longint read FA write SetA;');
|
||||
Add(' class property A2: longint read GetA write FA;');
|
||||
Add(' end;');
|
||||
Add(' TObjectClass = class of TObject;');
|
||||
Add('class function TObject.GetA: longint; begin end;');
|
||||
Add('class procedure TObject.SetA(Value: longint): longint; begin end;');
|
||||
Add('class procedure TObject.SetA(Value: longint); begin end;');
|
||||
Add('var');
|
||||
Add(' o: TObject;');
|
||||
Add(' oc: TObjectClass;');
|
||||
@ -7250,6 +7264,75 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_CopyConcat;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add(' TArrayInt = array of integer;');
|
||||
Add('function Get(A: TArrayInt): TArrayInt; begin end;');
|
||||
Add('var');
|
||||
Add(' i: integer;');
|
||||
Add(' A: TArrayInt;');
|
||||
Add('begin');
|
||||
Add(' A:=Copy(A);');
|
||||
Add(' A:=Copy(A,1);');
|
||||
Add(' A:=Copy(A,2,3);');
|
||||
Add(' A:=Copy(Get(A),2,3);');
|
||||
Add(' Get(Copy(A));');
|
||||
Add(' A:=Concat(A);');
|
||||
Add(' A:=Concat(A,Get(A));');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_CopyMismatchFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add(' TArrayInt = array of integer;');
|
||||
Add(' TArrayStr = array of string;');
|
||||
Add('var');
|
||||
Add(' i: integer;');
|
||||
Add(' A: TArrayInt;');
|
||||
Add(' B: TArrayStr;');
|
||||
Add('begin');
|
||||
Add(' A:=Copy(B);');
|
||||
CheckResolverException('Incompatible types: got "array of integer" expected "array of String"',
|
||||
nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_InsertDelete;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add(' TArrayInt = array of integer;');
|
||||
Add('var');
|
||||
Add(' i: integer;');
|
||||
Add(' A: TArrayInt;');
|
||||
Add('begin');
|
||||
Add(' Insert({#a1_read}i+1,{#a2_var}A,{#a3_read}i+2);');
|
||||
Add(' Delete({#b1_var}A,{#b2_read}i+3,{#b3_read}i+4);');
|
||||
ParseProgram;
|
||||
CheckAccessMarkers;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_InsertItemMismatchFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TCaption = string;');
|
||||
Add(' TArrayCap = array of TCaption;');
|
||||
Add('var');
|
||||
Add(' i: longint;');
|
||||
Add(' A: TArrayCap;');
|
||||
Add('begin');
|
||||
Add(' Insert(i,{#a2_var}A,2);');
|
||||
CheckResolverException('Incompatible types: got "Longint" expected "String"',
|
||||
nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcTypesAssignObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user