mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-11 14:10:31 +01:00
* Patch from Mattias Gaertner:
pscanner: - fixed reading ^a char literals pasresolver: - pred(), succ() - option for class properties non static - type cast integer to enum - <= and >= for sets - property of type array - low(), high() for sets - call constructor in class method - assign nil to dynamic array - resolve const expression git-svn-id: trunk@35415 -
This commit is contained in:
michael
parent
58abeb4a34
commit
203bd85c38
@ -70,13 +70,18 @@
|
||||
- enums - TPasEnumType, TPasEnumValue
|
||||
- propagate to parent scopes
|
||||
- function ord(): integer
|
||||
- function low(ordinal): ordinal
|
||||
- function high(ordinal): ordinal
|
||||
- function pred(ordinal): ordinal
|
||||
- function high(ordinal): ordinal
|
||||
- cast integer to enum
|
||||
- sets - TPasSetType
|
||||
- set of char
|
||||
- set of integer
|
||||
- set of boolean
|
||||
- set of enum
|
||||
- ranges 'a'..'z'
|
||||
- operators: +, -, *, ><
|
||||
- ranges 'a'..'z' 2..5
|
||||
- operators: +, -, *, ><, <=, >=
|
||||
- in-operator
|
||||
- assign operators: +=, -=, *=
|
||||
- include(), exclude()
|
||||
@ -91,11 +96,12 @@
|
||||
- function Assigned(Pointer or Class or Class-Of): boolean
|
||||
- arrays TPasArrayType
|
||||
- check if var initexpr fits vartype: var a: type = expr;
|
||||
- built-in functions high, low for range type and arrays
|
||||
- built-in functions high, low for range types, enums and arrays
|
||||
- procedure type
|
||||
- method type
|
||||
- function without params: mark if call or address, rrfImplicitCallWithoutParams
|
||||
- procedure break, procedure continue
|
||||
- built-in functions pred, succ for range type and enums
|
||||
|
||||
ToDo:
|
||||
- overloads
|
||||
@ -202,12 +208,13 @@ const
|
||||
nLeftSideOfIsOperatorExpectsAClassButGot = 3037;
|
||||
nNotReadable = 3038;
|
||||
nClassPropertyAccessorMustBeStatic = 3039;
|
||||
nOnlyOneDefaultPropertyIsAllowed = 3040;
|
||||
nWrongNumberOfParametersForArray = 3041;
|
||||
nCantAssignValuesToAnAddress = 3042;
|
||||
nIllegalExpression = 3043;
|
||||
nCantAccessPrivateMember = 3044;
|
||||
nMustBeInsideALoop = 3045;
|
||||
nClassPropertyAccessorMustNotBeStatic = 3040;
|
||||
nOnlyOneDefaultPropertyIsAllowed = 3041;
|
||||
nWrongNumberOfParametersForArray = 3042;
|
||||
nCantAssignValuesToAnAddress = 3043;
|
||||
nIllegalExpression = 3044;
|
||||
nCantAccessPrivateMember = 3045;
|
||||
nMustBeInsideALoop = 3046;
|
||||
|
||||
// resourcestring patterns of messages
|
||||
resourcestring
|
||||
@ -250,6 +257,7 @@ resourcestring
|
||||
sLeftSideOfIsOperatorExpectsAClassButGot = 'left side of is-operator expects a class, but got %s';
|
||||
sNotReadable = 'not readable';
|
||||
sClassPropertyAccessorMustBeStatic = 'class property accessor must be static';
|
||||
sClassPropertyAccessorMustNotBeStatic = 'class property accessor must not be static';
|
||||
sOnlyOneDefaultPropertyIsAllowed = 'Only one default property is allowed';
|
||||
sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
|
||||
sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
|
||||
@ -398,15 +406,17 @@ type
|
||||
bfSetLength,
|
||||
bfInclude,
|
||||
bfExclude,
|
||||
bfOrd,
|
||||
bfBreak,
|
||||
bfContinue,
|
||||
bfExit,
|
||||
bfInc,
|
||||
bfDec,
|
||||
bfAssigned,
|
||||
bfOrd,
|
||||
bfLow,
|
||||
bfHigh
|
||||
bfHigh,
|
||||
bfPred,
|
||||
bfSucc
|
||||
);
|
||||
TResolverBuiltInProcs = set of TResolverBuiltInProc;
|
||||
const
|
||||
@ -416,15 +426,17 @@ const
|
||||
'SetLength',
|
||||
'Include',
|
||||
'Exclude',
|
||||
'Ord',
|
||||
'Break',
|
||||
'Continue',
|
||||
'Exit',
|
||||
'Inc',
|
||||
'Dec',
|
||||
'Assigned',
|
||||
'Ord',
|
||||
'Low',
|
||||
'High'
|
||||
'High',
|
||||
'Pred',
|
||||
'Succ'
|
||||
);
|
||||
bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
|
||||
|
||||
@ -834,7 +846,8 @@ type
|
||||
PPRFindData = ^TPRFindData;
|
||||
|
||||
TPasResolverOption = (
|
||||
proFixCaseOfOverrides // fix Name of overriding procs to the overriden proc
|
||||
proFixCaseOfOverrides, // fix Name of overriding procs to the overriden proc
|
||||
proClassPropertyNonStatic // class property accessor must be non static
|
||||
);
|
||||
TPasResolverOptions = set of TPasResolverOption;
|
||||
|
||||
@ -991,10 +1004,6 @@ type
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
function OnGetCallCompatibility_InExclude(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
function OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function OnGetCallCompatibility_Break(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
function OnGetCallCompatibility_Continue(Proc: TResElDataBuiltInProc;
|
||||
@ -1007,10 +1016,18 @@ type
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure OnGetCallResult_Assigned(Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function OnGetCallCompatibility_LowHigh(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure OnGetCallResult_LowHigh(Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
function OnGetCallCompatibility_PredSucc(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
|
||||
procedure OnGetCallResult_PredSucc({%H-}Proc: TResElDataBuiltInProc;
|
||||
{%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -1127,6 +1144,8 @@ type
|
||||
function ExprIsAddrTarget(El: TPasExpr): boolean;
|
||||
function GetLastExprIdentifier(El: TPasExpr): TPasExpr;
|
||||
function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
|
||||
function TypeIsDynArray(TypeEl: TPasType): boolean;
|
||||
function IsClassMethod(El: TPasElement): boolean;
|
||||
public
|
||||
property BaseType[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseType;
|
||||
property BaseTypeStringIndex: TResolverBaseType read FBaseTypeStringIndex write FBaseTypeStringIndex;
|
||||
@ -2292,6 +2311,17 @@ begin
|
||||
{$ENDIF}
|
||||
CandidateFound:=true;
|
||||
end
|
||||
else if El.ClassType=TPasEnumType then
|
||||
begin
|
||||
// type cast to a enum
|
||||
Abort:=true; // can't be overloaded
|
||||
if Data^.Found<>nil then exit;
|
||||
Distance:=cExact;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.OnFindCallElements type cast to enum=',El.Name,' Distance=',Distance);
|
||||
{$ENDIF}
|
||||
CandidateFound:=true;
|
||||
end
|
||||
else if El is TPasVariable then
|
||||
begin
|
||||
Abort:=true; // can't be overloaded
|
||||
@ -3069,7 +3099,10 @@ end;
|
||||
procedure TPasResolver.FinishVariable(El: TPasVariable);
|
||||
begin
|
||||
if El.Expr<>nil then
|
||||
begin
|
||||
ResolveExpr(El.Expr);
|
||||
CheckAssignCompatibility(El,El.Expr,true);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
|
||||
@ -3256,8 +3289,11 @@ begin
|
||||
begin
|
||||
if Proc.ClassType<>TPasClassFunction then
|
||||
RaiseXExpectedButYFound('class function',Proc.ElementTypeName,PropEl.ReadAccessor);
|
||||
if not Proc.IsStatic then
|
||||
RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
|
||||
if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
|
||||
else
|
||||
RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -3303,8 +3339,11 @@ begin
|
||||
begin
|
||||
if Proc.ClassType<>TPasClassProcedure then
|
||||
RaiseXExpectedButYFound('class procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
|
||||
if not Proc.IsStatic then
|
||||
RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
|
||||
if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
|
||||
if Proc.IsStatic then
|
||||
RaiseMsg(nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
|
||||
else
|
||||
RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -5078,27 +5117,51 @@ begin
|
||||
eopAdd,
|
||||
eopSubtract,
|
||||
eopMultiply,
|
||||
eopSymmetricaldifference:
|
||||
eopSymmetricaldifference,
|
||||
eopLessthanEqual,
|
||||
eopGreaterThanEqual:
|
||||
begin
|
||||
if RightResolved.TypeEl=nil then
|
||||
begin
|
||||
// right is empty set
|
||||
ResolvedEl:=LeftResolved;
|
||||
if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
|
||||
SetBaseType(btBoolean)
|
||||
else
|
||||
begin
|
||||
ResolvedEl:=LeftResolved;
|
||||
ResolvedEl.IdentEl:=nil;
|
||||
ResolvedEl.ExprEl:=Bin;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
if LeftResolved.TypeEl=nil then
|
||||
end
|
||||
else if LeftResolved.TypeEl=nil then
|
||||
begin
|
||||
// left is empty set
|
||||
ResolvedEl:=RightResolved;
|
||||
if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
|
||||
SetBaseType(btBoolean)
|
||||
else
|
||||
begin
|
||||
ResolvedEl:=RightResolved;
|
||||
ResolvedEl.IdentEl:=nil;
|
||||
ResolvedEl.ExprEl:=Bin;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
if (LeftResolved.SubType=RightResolved.SubType)
|
||||
end
|
||||
else if (LeftResolved.SubType=RightResolved.SubType)
|
||||
or ((LeftResolved.SubType in btAllBooleans)
|
||||
and (RightResolved.SubType in btAllBooleans))
|
||||
or ((LeftResolved.SubType in btAllInteger)
|
||||
and (RightResolved.SubType in btAllInteger)) then
|
||||
begin
|
||||
ResolvedEl:=LeftResolved;
|
||||
// compatible set
|
||||
if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
|
||||
SetBaseType(btBoolean)
|
||||
else
|
||||
begin
|
||||
ResolvedEl:=LeftResolved;
|
||||
ResolvedEl.IdentEl:=nil;
|
||||
ResolvedEl.ExprEl:=Bin;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
@ -5124,6 +5187,18 @@ end;
|
||||
|
||||
procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
|
||||
ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
|
||||
|
||||
procedure ComputeIndexProperty(Prop: TPasProperty);
|
||||
begin
|
||||
ComputeElement(GetPasPropertyType(Prop),ResolvedEl,Flags-[rcReturnFuncResult]);
|
||||
ResolvedEl.IdentEl:=Prop;
|
||||
ResolvedEl.Flags:=[];
|
||||
if GetPasPropertyGetter(Prop)<>nil then
|
||||
Include(ResolvedEl.Flags,rrfReadable);
|
||||
if GetPasPropertySetter(Prop)<>nil then
|
||||
Include(ResolvedEl.Flags,rrfWritable);
|
||||
end;
|
||||
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
ClassScope: TPasClassScope;
|
||||
@ -5151,6 +5226,9 @@ begin
|
||||
else
|
||||
RaiseNotYetImplemented(20160928174144,Params);
|
||||
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDesc(ResolvedEl));
|
||||
{$ENDIF}
|
||||
if ResolvedEl.BaseType in btAllStrings then
|
||||
begin
|
||||
// stringvar[] => char
|
||||
@ -5162,8 +5240,10 @@ begin
|
||||
ResolvedEl.TypeEl:=FBaseTypes[ResolvedEl.BaseType];
|
||||
ResolvedEl.ExprEl:=Params;
|
||||
end
|
||||
else if ResolvedEl.IdentEl is TPasProperty then
|
||||
else if (ResolvedEl.IdentEl is TPasProperty)
|
||||
and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
|
||||
// property with args
|
||||
ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
|
||||
else if ResolvedEl.BaseType=btContext then
|
||||
begin
|
||||
TypeEl:=ResolvedEl.TypeEl;
|
||||
@ -5172,14 +5252,14 @@ begin
|
||||
ClassScope:=TypeEl.CustomData as TPasClassScope;
|
||||
if ClassScope.DefaultProperty=nil then
|
||||
RaiseInternalError(20161010151747);
|
||||
ComputeElement(ClassScope.DefaultProperty,ResolvedEl,[]);
|
||||
ComputeIndexProperty(ClassScope.DefaultProperty);
|
||||
end
|
||||
else if TypeEl.ClassType=TPasClassOfType then
|
||||
begin
|
||||
ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPasClassScope;
|
||||
if ClassScope.DefaultProperty=nil then
|
||||
RaiseInternalError(20161010174916);
|
||||
ComputeElement(ClassScope.DefaultProperty,ResolvedEl,[]);
|
||||
ComputeIndexProperty(ClassScope.DefaultProperty);
|
||||
end
|
||||
else if TypeEl.ClassType=TPasArrayType then
|
||||
begin
|
||||
@ -5288,6 +5368,7 @@ begin
|
||||
// type cast
|
||||
ResolvedTypeEl:=ResolvedEl;
|
||||
ComputeElement(Params.Params[0],ResolvedEl,[rcReturnFuncResult]);
|
||||
ResolvedEl.BaseType:=ResolvedTypeEl.BaseType;
|
||||
ResolvedEl.TypeEl:=ResolvedTypeEl.TypeEl;
|
||||
end
|
||||
else
|
||||
@ -5308,6 +5389,9 @@ begin
|
||||
ComputeElement(Params.Params[0],ResolvedEl,Flags+[rcReturnFuncResult]);
|
||||
if ResolvedEl.BaseType=btRange then
|
||||
ConvertRangeToFirstValue(ResolvedEl);
|
||||
ResolvedEl.IdentEl:=nil;
|
||||
if ResolvedEl.ExprEl=nil then
|
||||
ResolvedEl.ExprEl:=Params;
|
||||
ResolvedEl.SubType:=ResolvedEl.BaseType;
|
||||
ResolvedEl.BaseType:=btSet;
|
||||
ResolvedEl.Flags:=[rrfReadable];
|
||||
@ -5665,59 +5749,6 @@ begin
|
||||
Result:=cExact;
|
||||
end;
|
||||
|
||||
function TPasResolver.OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
begin
|
||||
if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// first param: enum or char
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ParamResolved,[rcReturnFuncResult]);
|
||||
Result:=cIncompatible;
|
||||
if rrfReadable in ParamResolved.Flags then
|
||||
begin
|
||||
if ParamResolved.BaseType=btChar then
|
||||
Result:=cExact
|
||||
else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
|
||||
end;
|
||||
|
||||
function TPasResolver.OnGetCallCompatibility_Break(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
var
|
||||
@ -5955,6 +5986,59 @@ begin
|
||||
SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,FBaseTypes[btBoolean],[rrfReadable]);
|
||||
end;
|
||||
|
||||
function TPasResolver.OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
|
||||
Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
begin
|
||||
if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// first param: enum or char
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ParamResolved,[rcReturnFuncResult]);
|
||||
Result:=cIncompatible;
|
||||
if rrfReadable in ParamResolved.Flags then
|
||||
begin
|
||||
if ParamResolved.BaseType=btChar then
|
||||
Result:=cExact
|
||||
else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
|
||||
end;
|
||||
|
||||
function TPasResolver.OnGetCallCompatibility_LowHigh(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
// check params of built in proc 'Low' or 'High'
|
||||
@ -5962,6 +6046,7 @@ var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
|
||||
begin
|
||||
@ -5978,8 +6063,15 @@ begin
|
||||
Result:=cIncompatible;
|
||||
if CheckIsOrdinal(ParamResolved,Param,false) then
|
||||
Result:=cExact
|
||||
else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl.ClassType=TPasArrayType) then
|
||||
Result:=cExact;
|
||||
else if ParamResolved.BaseType=btSet then
|
||||
Result:=cExact
|
||||
else if (ParamResolved.BaseType=btContext) then
|
||||
begin
|
||||
TypeEl:=ParamResolved.TypeEl;
|
||||
if (TypeEl.ClassType=TPasArrayType)
|
||||
or (TypeEl.ClassType=TPasSetType) then
|
||||
Result:=cExact;
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
@ -6004,26 +6096,92 @@ procedure TPasResolver.OnGetCallResult_LowHigh(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
|
||||
var
|
||||
ArrayEl: TPasArrayType;
|
||||
Param: TPasExpr;
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
ComputeElement(Params.Params[0],ResolvedEl,[]);
|
||||
if ResolvedEl.TypeEl.ClassType=TPasArrayType then
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ResolvedEl,[]);
|
||||
if ResolvedEl.BaseType=btContext then
|
||||
begin
|
||||
// array: result type is type of first dimension
|
||||
ArrayEl:=TPasArrayType(ResolvedEl.TypeEl);
|
||||
if length(ArrayEl.Ranges)=0 then
|
||||
SetResolverIdentifier(ResolvedEl,btInt64,Proc.Proc,FBaseTypes[btInt64],[rrfReadable])
|
||||
else
|
||||
TypeEl:=ResolvedEl.TypeEl;
|
||||
if TypeEl.ClassType=TPasArrayType then
|
||||
begin
|
||||
ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcReturnFuncResult]);
|
||||
if ResolvedEl.BaseType=btRange then
|
||||
ConvertRangeToFirstValue(ResolvedEl);
|
||||
// array: result type is type of first dimension
|
||||
ArrayEl:=TPasArrayType(TypeEl);
|
||||
if length(ArrayEl.Ranges)=0 then
|
||||
SetResolverIdentifier(ResolvedEl,btInt64,Proc.Proc,FBaseTypes[btInt64],[rrfReadable])
|
||||
else
|
||||
begin
|
||||
ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcReturnFuncResult]);
|
||||
if ResolvedEl.BaseType=btRange then
|
||||
ConvertRangeToFirstValue(ResolvedEl);
|
||||
end;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasSetType then
|
||||
begin
|
||||
ResolvedEl.TypeEl:=TPasSetType(TypeEl).EnumType;
|
||||
end;
|
||||
end
|
||||
else if ResolvedEl.BaseType=btSet then
|
||||
begin
|
||||
ResolvedEl.BaseType:=ResolvedEl.SubType;
|
||||
ResolvedEl.SubType:=btNone;
|
||||
end
|
||||
else
|
||||
;// ordinal: result type is argument type
|
||||
ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
|
||||
end;
|
||||
|
||||
function TPasResolver.OnGetCallCompatibility_PredSucc(
|
||||
Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
|
||||
// check params of built in proc 'Pred' or 'Succ'
|
||||
var
|
||||
Params: TParamsExpr;
|
||||
Param: TPasExpr;
|
||||
ParamResolved: TPasResolverResult;
|
||||
begin
|
||||
if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
Params:=TParamsExpr(Expr);
|
||||
|
||||
// first param: enum, range, set, char or integer
|
||||
Param:=Params.Params[0];
|
||||
ComputeElement(Param,ParamResolved,[]);
|
||||
Result:=cIncompatible;
|
||||
if CheckIsOrdinal(ParamResolved,Param,false) then
|
||||
Result:=cExact;
|
||||
if Result=cIncompatible then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
|
||||
['1',GetTypeDesc(ParamResolved.TypeEl),'ordinal'],
|
||||
Param);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if length(Params.Params)>1 then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
|
||||
Result:=cExact;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.OnGetCallResult_PredSucc(Proc: TResElDataBuiltInProc;
|
||||
Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
ComputeElement(Params.Params[0],ResolvedEl,[]);
|
||||
ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
|
||||
end;
|
||||
|
||||
constructor TPasResolver.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -6227,7 +6385,7 @@ var
|
||||
begin
|
||||
StartScope:=FindData.StartScope;
|
||||
OnlyTypeMembers:=false;
|
||||
if (StartScope is TPasDotIdentifierScope) then
|
||||
if StartScope is TPasDotIdentifierScope then
|
||||
begin
|
||||
OnlyTypeMembers:=TPasDotIdentifierScope(StartScope).OnlyTypeMembers;
|
||||
Include(Ref.Flags,rrfDotScope);
|
||||
@ -6236,6 +6394,13 @@ begin
|
||||
begin
|
||||
OnlyTypeMembers:=TPasWithExprScope(StartScope).OnlyTypeMembers;
|
||||
Include(Ref.Flags,rrfDotScope);
|
||||
end
|
||||
else if StartScope.ClassType=TPasProcedureScope then
|
||||
begin
|
||||
Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
|
||||
//writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
|
||||
if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
|
||||
OnlyTypeMembers:=true;
|
||||
end;
|
||||
|
||||
//writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
|
||||
@ -6250,11 +6415,7 @@ begin
|
||||
// only class vars/procs allowed
|
||||
if (FindData.Found.ClassType=TPasConstructor) then
|
||||
// constructor: ok
|
||||
else if (FindData.Found.ClassType=TPasClassConstructor)
|
||||
or (FindData.Found.ClassType=TPasClassDestructor)
|
||||
or (FindData.Found.ClassType=TPasClassProcedure)
|
||||
or (FindData.Found.ClassType=TPasClassFunction)
|
||||
or (FindData.Found.ClassType=TPasClassOperator)
|
||||
else if IsClassMethod(FindData.Found)
|
||||
then
|
||||
// class proc: ok
|
||||
else if (FindData.Found is TPasVariable)
|
||||
@ -6299,8 +6460,11 @@ begin
|
||||
Ref.Context:=TResolvedRefCtxConstructor.Create;
|
||||
if StartScope is TPasDotClassScope then
|
||||
TypeEl:=TPasDotClassScope(StartScope).ClassScope.Element as TPasType
|
||||
else if (StartScope is TPasWithExprScope) and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
|
||||
else if (StartScope is TPasWithExprScope)
|
||||
and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
|
||||
TypeEl:=TPasClassScope(TPasWithExprScope(StartScope).Scope).Element as TPasType
|
||||
else if (StartScope is TPasProcedureScope) then
|
||||
TypeEl:=TPasProcedureScope(StartScope).ClassScope.Element as TPasType
|
||||
else
|
||||
RaiseInternalError(20170131150855,GetObjName(StartScope));
|
||||
TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
|
||||
@ -6483,9 +6647,6 @@ begin
|
||||
if bfExclude in BaseProcs then
|
||||
AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
|
||||
@OnGetCallCompatibility_InExclude,nil,bfExclude);
|
||||
if bfOrd in BaseProcs then
|
||||
AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
|
||||
if bfBreak in BaseProcs then
|
||||
AddBuiltInProc('Break','procedure Break',
|
||||
@OnGetCallCompatibility_Break,nil,bfBreak);
|
||||
@ -6504,12 +6665,21 @@ begin
|
||||
if bfAssigned in BaseProcs then
|
||||
AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
|
||||
@OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned,bfAssigned);
|
||||
if bfOrd in BaseProcs then
|
||||
AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
|
||||
if bfLow in BaseProcs then
|
||||
AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfLow);
|
||||
if bfHigh in BaseProcs then
|
||||
AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfHigh);
|
||||
if bfPred in BaseProcs then
|
||||
AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
|
||||
@OnGetCallCompatibility_PredSucc,@OnGetCallResult_PredSucc,bfPred);
|
||||
if bfSucc in BaseProcs then
|
||||
AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
|
||||
@OnGetCallCompatibility_PredSucc,@OnGetCallResult_PredSucc,bfSucc);
|
||||
end;
|
||||
|
||||
function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType
|
||||
@ -7087,7 +7257,6 @@ begin
|
||||
or (Arg1Resolved.TypeEl<>Arg2Resolved.TypeEl) then
|
||||
exit;
|
||||
|
||||
// ToDo: check Arg1.ValueExpr
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -7102,6 +7271,9 @@ begin
|
||||
begin
|
||||
if ErrorOnFalse then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.CheckCanBeLHS ',GetResolverResultDesc(ResolvedEl));
|
||||
{$ENDIF}
|
||||
if (ResolvedEl.TypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
|
||||
RaiseXExpectedButYFound('identifier',ResolvedEl.TypeEl.ElementTypeName,ResolvedEl.ExprEl)
|
||||
else
|
||||
@ -7134,6 +7306,7 @@ function TPasResolver.CheckAssignCompatibility(const LHS,
|
||||
): integer;
|
||||
var
|
||||
Expected, Actual: String;
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
// check if the RHS can be converted to LHS
|
||||
{$IFDEF VerbosePasResolver}
|
||||
@ -7185,10 +7358,12 @@ begin
|
||||
exit(cExact)
|
||||
else if LHS.BaseType=btContext then
|
||||
begin
|
||||
if (LHS.TypeEl.ClassType=TPasClassType)
|
||||
or (LHS.TypeEl.ClassType=TPasClassOfType)
|
||||
or (LHS.TypeEl.ClassType=TPasPointerType)
|
||||
or (LHS.TypeEl is TPasProcedureType) then
|
||||
TypeEl:=LHS.TypeEl;
|
||||
if (TypeEl.ClassType=TPasClassType)
|
||||
or (TypeEl.ClassType=TPasClassOfType)
|
||||
or (TypeEl.ClassType=TPasPointerType)
|
||||
or (TypeEl is TPasProcedureType)
|
||||
or TypeIsDynArray(TypeEl) then
|
||||
exit(cExact);
|
||||
end;
|
||||
end
|
||||
@ -7242,6 +7417,8 @@ end;
|
||||
function TPasResolver.CheckEqualCompatibility(const LHS,
|
||||
RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
|
||||
): integer;
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
// check if the RHS is type compatible to LHS
|
||||
@ -7270,10 +7447,12 @@ begin
|
||||
exit(cExact)
|
||||
else if RHS.BaseType=btContext then
|
||||
begin
|
||||
if (RHS.TypeEl.ClassType=TPasClassType)
|
||||
or (RHS.TypeEl.ClassType=TPasClassOfType)
|
||||
or (RHS.TypeEl.ClassType=TPasPointerType)
|
||||
or (RHS.TypeEl is TPasProcedureType) then
|
||||
TypeEl:=RHS.TypeEl;
|
||||
if (TypeEl.ClassType=TPasClassType)
|
||||
or (TypeEl.ClassType=TPasClassOfType)
|
||||
or (TypeEl.ClassType=TPasPointerType)
|
||||
or (TypeEl is TPasProcedureType)
|
||||
or TypeIsDynArray(TypeEl) then
|
||||
exit(cExact);
|
||||
end
|
||||
else if RaiseOnIncompatible then
|
||||
@ -7288,10 +7467,12 @@ begin
|
||||
exit(cExact)
|
||||
else if LHS.BaseType=btContext then
|
||||
begin
|
||||
if (LHS.TypeEl.ClassType=TPasClassType)
|
||||
or (LHS.TypeEl.ClassType=TPasClassOfType)
|
||||
or (LHS.TypeEl.ClassType=TPasPointerType)
|
||||
or (LHS.TypeEl is TPasProcedureType) then
|
||||
TypeEl:=LHS.TypeEl;
|
||||
if (TypeEl.ClassType=TPasClassType)
|
||||
or (TypeEl.ClassType=TPasClassOfType)
|
||||
or (TypeEl.ClassType=TPasPointerType)
|
||||
or (TypeEl is TPasProcedureType)
|
||||
or TypeIsDynArray(TypeEl) then
|
||||
exit(cExact);
|
||||
end
|
||||
else if RaiseOnIncompatible then
|
||||
@ -7816,6 +7997,11 @@ begin
|
||||
if Result=cIncompatible then
|
||||
Result:=CheckSrcIsADstType(ParamResolved,ResolvedEl,Param);
|
||||
end;
|
||||
end
|
||||
else if ResolvedEl.TypeEl.ClassType=TPasEnumType then
|
||||
begin
|
||||
if CheckIsOrdinal(ParamResolved,Param,true) then
|
||||
Result:=cExact;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -8041,13 +8227,19 @@ begin
|
||||
begin
|
||||
if rcConstant in Flags then
|
||||
RaiseConstantExprExp(El);
|
||||
ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,Flags-[rcReturnFuncResult]);
|
||||
ResolvedEl.IdentEl:=El;
|
||||
ResolvedEl.Flags:=[];
|
||||
if GetPasPropertyGetter(TPasProperty(El))<>nil then
|
||||
Include(ResolvedEl.Flags,rrfReadable);
|
||||
if GetPasPropertySetter(TPasProperty(El))<>nil then
|
||||
Include(ResolvedEl.Flags,rrfWritable);
|
||||
if TPasProperty(El).Args.Count=0 then
|
||||
begin
|
||||
ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,Flags-[rcReturnFuncResult]);
|
||||
ResolvedEl.IdentEl:=El;
|
||||
ResolvedEl.Flags:=[];
|
||||
if GetPasPropertyGetter(TPasProperty(El))<>nil then
|
||||
Include(ResolvedEl.Flags,rrfReadable);
|
||||
if GetPasPropertySetter(TPasProperty(El))<>nil then
|
||||
Include(ResolvedEl.Flags,rrfWritable);
|
||||
end
|
||||
else
|
||||
// index property
|
||||
SetResolverIdentifier(ResolvedEl,btContext,El,nil,[]);
|
||||
end
|
||||
else if El.ClassType=TPasArgument then
|
||||
begin
|
||||
@ -8239,6 +8431,22 @@ begin
|
||||
Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
|
||||
end;
|
||||
|
||||
function TPasResolver.TypeIsDynArray(TypeEl: TPasType): boolean;
|
||||
begin
|
||||
Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
|
||||
and (length(TPasArrayType(TypeEl).Ranges)=0);
|
||||
end;
|
||||
|
||||
function TPasResolver.IsClassMethod(El: TPasElement): boolean;
|
||||
begin
|
||||
Result:=(El<>nil)
|
||||
and ((El.ClassType=TPasClassConstructor)
|
||||
or (El.ClassType=TPasClassDestructor)
|
||||
or (El.ClassType=TPasClassProcedure)
|
||||
or (El.ClassType=TPasClassFunction)
|
||||
or (El.ClassType=TPasClassOperator));
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
|
||||
ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
|
||||
// finds distance between classes SrcType and DestType
|
||||
|
||||
@ -710,7 +710,7 @@ type
|
||||
end;
|
||||
|
||||
{ TPasVariable }
|
||||
TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass,vmStatic);
|
||||
TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass, vmStatic);
|
||||
TVariableModifiers = set of TVariableModifier;
|
||||
|
||||
TPasVariable = class(TPasElement)
|
||||
@ -1392,6 +1392,9 @@ const
|
||||
'static','inline','assembler','varargs', 'public',
|
||||
'compilerproc','external','forward','dispid','noreturn');
|
||||
|
||||
VariableModifierNames : Array[TVariableModifier] of string
|
||||
= ('cvar', 'external', 'public', 'export', 'class', 'static');
|
||||
|
||||
procedure ReleaseAndNil(var El: TPasElement); overload;
|
||||
|
||||
implementation
|
||||
|
||||
@ -2352,7 +2352,7 @@ var
|
||||
TypeName: String;
|
||||
PT : TProcType;
|
||||
NamePos: TPasSourcePos;
|
||||
OldForceCaret,ok: Boolean;
|
||||
ok: Boolean;
|
||||
|
||||
begin
|
||||
CurBlock := declNone;
|
||||
@ -2455,7 +2455,7 @@ begin
|
||||
end;
|
||||
declType:
|
||||
begin
|
||||
OldForceCaret:=Scanner.SetForceCaret(True);
|
||||
Scanner.SetForceCaret(True);
|
||||
TypeEl := ParseTypeDecl(Declarations);
|
||||
// Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
|
||||
if Assigned(TypeEl) then // !!!
|
||||
@ -3940,10 +3940,9 @@ begin
|
||||
begin
|
||||
NextToken;
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
UngetToken;
|
||||
UNgettoken;
|
||||
El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
|
||||
TPasImplIfElse(El).ConditionExpr:=Left;
|
||||
Left.Parent:=El;
|
||||
//WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
|
||||
CreateBlock(TPasImplIfElse(El));
|
||||
ExpectToken(tkthen);
|
||||
@ -4004,8 +4003,8 @@ begin
|
||||
begin
|
||||
// while Condition do
|
||||
NextToken;
|
||||
left:=DoParseExpression(CurBlock);
|
||||
UngetToken;
|
||||
left:=DoParseExpression(Parent);
|
||||
ungettoken;
|
||||
//WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
|
||||
El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
|
||||
TPasImplWhileDo(El).ConditionExpr:=left;
|
||||
@ -4014,7 +4013,7 @@ begin
|
||||
end;
|
||||
tkgoto:
|
||||
begin
|
||||
NextToken;
|
||||
nexttoken;
|
||||
curblock.AddCommand('goto '+curtokenstring);
|
||||
expecttoken(tkSemiColon);
|
||||
end;
|
||||
@ -4081,18 +4080,17 @@ begin
|
||||
// with Expr, Expr do
|
||||
SrcPos:=Scanner.CurSourcePos;
|
||||
NextToken;
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
Left:=DoParseExpression(Parent);
|
||||
//writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
|
||||
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
|
||||
TPasImplWithDo(El).AddExpression(Left);
|
||||
Left.Parent:=El;
|
||||
CreateBlock(TPasImplWithDo(El));
|
||||
repeat
|
||||
if CurToken=tkdo then break;
|
||||
if CurToken<>tkComma then
|
||||
ParseExcTokenError(TokenInfos[tkdo]);
|
||||
NextToken;
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
Left:=DoParseExpression(Parent);
|
||||
//writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
|
||||
TPasImplWithDo(CurBlock).AddExpression(Left);
|
||||
until false;
|
||||
@ -4100,7 +4098,7 @@ begin
|
||||
tkcase:
|
||||
begin
|
||||
NextToken;
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
Left:=DoParseExpression(Parent);
|
||||
UngetToken;
|
||||
//writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
|
||||
ExpectToken(tkof);
|
||||
@ -4301,7 +4299,7 @@ begin
|
||||
if CurBlock is TPasImplRepeatUntil then
|
||||
begin
|
||||
NextToken;
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
Left:=DoParseExpression(Parent);
|
||||
UngetToken;
|
||||
TPasImplRepeatUntil(CurBlock).ConditionExpr:=Left;
|
||||
//WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
|
||||
@ -4310,7 +4308,7 @@ begin
|
||||
ParseExcSyntaxError;
|
||||
end;
|
||||
else
|
||||
left:=DoParseExpression(CurBlock);
|
||||
left:=DoParseExpression(Parent);
|
||||
case CurToken of
|
||||
tkAssign,
|
||||
tkAssignPlus,
|
||||
@ -4321,7 +4319,7 @@ begin
|
||||
// assign statement
|
||||
Ak:=TokenToAssignKind(CurToken);
|
||||
NextToken;
|
||||
right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
|
||||
right:=DoParseExpression(Parent); // this may solve TPasImplWhileDo.AddElement BUG
|
||||
El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
|
||||
left.Parent:=El;
|
||||
right.Parent:=El;
|
||||
|
||||
@ -1409,13 +1409,15 @@ begin
|
||||
OldLength:=0;
|
||||
FCurTokenString := '';
|
||||
|
||||
while TokenStr[0] in ['^','#', ''''] do
|
||||
begin
|
||||
repeat
|
||||
case TokenStr[0] of
|
||||
'^' :
|
||||
begin
|
||||
TokenStart := TokenStr;
|
||||
Inc(TokenStr);
|
||||
if TokenStr[0] in ['a'..'z','A'..'Z'] then
|
||||
Inc(TokenStr);
|
||||
if Result=tkEOF then Result := tkChar else Result:=tkString;
|
||||
end;
|
||||
'#':
|
||||
begin
|
||||
@ -1465,8 +1467,7 @@ begin
|
||||
if SectionLength > 0 then
|
||||
Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
|
||||
Inc(OldLength, SectionLength);
|
||||
end;
|
||||
|
||||
until false;
|
||||
end;
|
||||
|
||||
procedure TPascalScanner.PushStackItem;
|
||||
@ -1780,8 +1781,9 @@ end;
|
||||
Procedure TPascalScanner.HandleELSE(Const AParam : String);
|
||||
|
||||
begin
|
||||
if AParam='' then;
|
||||
if PPSkipStackIndex = 0 then
|
||||
Error(nErrInvalidPPElse,sErrInvalidPPElse);
|
||||
Error(nErrInvalidPPElse,sErrInvalidPPElse);
|
||||
if PPSkipMode = ppSkipIfBranch then
|
||||
PPIsSkipping := false
|
||||
else if PPSkipMode = ppSkipElseBranch then
|
||||
@ -1792,6 +1794,7 @@ end;
|
||||
Procedure TPascalScanner.HandleENDIF(Const AParam : String);
|
||||
|
||||
begin
|
||||
if AParam='' then;
|
||||
if PPSkipStackIndex = 0 then
|
||||
Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
|
||||
Dec(PPSkipStackIndex);
|
||||
|
||||
@ -142,6 +142,7 @@ type
|
||||
Procedure TestVarInteger;
|
||||
Procedure TestConstInteger;
|
||||
Procedure TestDuplicateVar;
|
||||
Procedure TestVarInitConst;
|
||||
Procedure TestVarOfVarFail;
|
||||
Procedure TestConstOfVarFail;
|
||||
Procedure TestTypedConstWrongExprFail;
|
||||
@ -150,12 +151,20 @@ type
|
||||
Procedure TestIncDec;
|
||||
Procedure TestIncStringFail;
|
||||
|
||||
// strings
|
||||
Procedure TestString_SetLength;
|
||||
|
||||
// enums
|
||||
Procedure TestEnums;
|
||||
Procedure TestSets;
|
||||
Procedure TestSetOperators;
|
||||
Procedure TestEnumParams;
|
||||
Procedure TestSetParams;
|
||||
Procedure TestSetFunctions;
|
||||
Procedure TestEnumHighLow;
|
||||
Procedure TestEnumOrd;
|
||||
Procedure TestEnumPredSucc;
|
||||
Procedure TestEnum_CastIntegerToEnum;
|
||||
|
||||
// operators
|
||||
Procedure TestPrgAssignment;
|
||||
@ -223,6 +232,7 @@ type
|
||||
Procedure TestUnitIntfMismatchArgName;
|
||||
Procedure TestProcOverloadIsNotFunc;
|
||||
Procedure TestProcCallMissingParams;
|
||||
Procedure TestProcArgDefaultValueTypeMismatch;
|
||||
Procedure TestBuiltInProcCallMissingParams;
|
||||
Procedure TestAssignFunctionResult;
|
||||
Procedure TestAssignProcResultFail;
|
||||
@ -331,7 +341,11 @@ type
|
||||
Procedure TestPropertyArgs1;
|
||||
Procedure TestPropertyArgs2;
|
||||
Procedure TestPropertyArgsWithDefaultsFail;
|
||||
Procedure TestProperty_Index;
|
||||
Procedure TestProperty_WrongTypeAsIndexFail;
|
||||
Procedure TestProperty_Option_ClassPropertyNonStatic;
|
||||
Procedure TestDefaultProperty;
|
||||
Procedure TestMissingDefaultProperty;
|
||||
|
||||
// with
|
||||
Procedure TestWithBlock1;
|
||||
@ -345,6 +359,7 @@ type
|
||||
Procedure TestArrayOfArray;
|
||||
Procedure TestFunctionReturningArray;
|
||||
Procedure TestLowHighArray;
|
||||
Procedure TestPropertyOfTypeArray;
|
||||
|
||||
// procedure types
|
||||
Procedure TestProcTypesAssignObjFPC;
|
||||
@ -1475,6 +1490,15 @@ begin
|
||||
CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestVarInitConst;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('const {#c}c=1;');
|
||||
Add('var a: longint = {@c}c;');
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestVarOfVarFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1550,13 +1574,24 @@ begin
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestString_SetLength;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('var');
|
||||
Add(' s: string;');
|
||||
Add('begin');
|
||||
Add(' SetLength(s,3);');
|
||||
Add(' SetLength(s,length(s));');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestEnums;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);');
|
||||
Add('var');
|
||||
Add(' {#f}{=TFlag}f: TFlag;');
|
||||
Add(' {#v}{=TFlag}v: TFlag;');
|
||||
Add(' {#v}{=TFlag}v: TFlag = Green;');
|
||||
Add('begin');
|
||||
Add(' {@f}f:={@Red}Red;');
|
||||
Add(' {@f}f:={@v}v;');
|
||||
@ -1588,7 +1623,7 @@ begin
|
||||
Add('var');
|
||||
Add(' {#f}{=TFlag}f: TFlag;');
|
||||
Add(' {#s}{=TFlags}s: TFlags;');
|
||||
Add(' {#t}{=TFlags}t: TFlags;');
|
||||
Add(' {#t}{=TFlags}t: TFlags = [Green,Gray];');
|
||||
Add(' {#Chars}{=TChars}Chars: TChars;');
|
||||
Add(' {#MyInts}{=TMyInts}MyInts: TMyInts;');
|
||||
Add(' {#MyBools}{=TMyBools}MyBools: TMyBools;');
|
||||
@ -1598,30 +1633,6 @@ begin
|
||||
Add(' {@s}s:=[{@Red}Red];');
|
||||
Add(' {@s}s:=[{@Red}Red,{@Blue}Blue];');
|
||||
Add(' {@s}s:=[{@Gray}Gray..{@White}White];');
|
||||
Add(' {@s}s:=[{@Red}Red]+[{@Blue}Blue,{@Gray}Gray];');
|
||||
Add(' {@s}s:=[{@Blue}Blue,{@Gray}Gray]-[{@Blue}Blue];');
|
||||
Add(' {@s}s:={@t}t+[];');
|
||||
Add(' {@s}s:=[{@Red}Red]+{@s}s;');
|
||||
Add(' {@s}s:={@s}s+[{@Red}Red];');
|
||||
Add(' {@s}s:=[{@Red}Red]-{@s}s;');
|
||||
Add(' {@s}s:={@s}s-[{@Red}Red];');
|
||||
Add(' Include({@s}s,{@Blue}Blue);');
|
||||
Add(' Exclude({@s}s,{@Blue}Blue);');
|
||||
Add(' {@s}s:={@s}s+[{@f}f];');
|
||||
Add(' if {@Green}Green in {@s}s then ;');
|
||||
Add(' if {@Blue}Blue in {@Colors}Colors then ;');
|
||||
Add(' if {@f}f in {@ExtColors}ExtColors then ;');
|
||||
Add(' {@s}s:={@s}s * Colors;');
|
||||
Add(' {@s}s:=Colors * {@s}s;');
|
||||
Add(' s:=ExtColors * Colors;');
|
||||
Add(' s:=Colors >< ExtColors;');
|
||||
Add(' s:=s >< ExtColors;');
|
||||
Add(' s:=ExtColors >< s;');
|
||||
Add(' if ''p'' in [''a''..''z''] then ; ');
|
||||
Add(' if ''p'' in [''a''..''z'',''A''..''Z'',''0''..''9'',''_''] then ; ');
|
||||
Add(' if ''p'' in {@Chars}Chars then ; ');
|
||||
Add(' if 7 in {@MyInts}MyInts then ; ');
|
||||
Add(' if 7 in [1+2,(3*4)+5,(-2+6)..(8-3)] then ; ');
|
||||
Add(' {@MyInts}MyInts:=[1];');
|
||||
Add(' {@MyInts}MyInts:=[1,2];');
|
||||
Add(' {@MyInts}MyInts:=[1..2];');
|
||||
@ -1631,7 +1642,71 @@ begin
|
||||
Add(' {@MyBools}MyBools:=[false];');
|
||||
Add(' {@MyBools}MyBools:=[false,true];');
|
||||
Add(' {@MyBools}MyBools:=[true..false];');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestSetOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
|
||||
Add(' {#TFlags}TFlags = set of TFlag;');
|
||||
Add(' {#TChars}TChars = set of Char;');
|
||||
Add(' {#TMyInt}TMyInt = 0..17;');
|
||||
Add(' {#TMyInts}TMyInts = set of TMyInt;');
|
||||
Add(' {#TMyBools}TMyBools = set of boolean;');
|
||||
Add('const');
|
||||
Add(' {#Colors}Colors = [{@Red}Red..{@Blue}Blue];');
|
||||
Add(' {#ExtColors}ExtColors = {@Colors}Colors+[{@White}White,{@Black}Black];');
|
||||
Add('var');
|
||||
Add(' {#f}{=TFlag}f: TFlag;');
|
||||
Add(' {#s}{=TFlags}s: TFlags;');
|
||||
Add(' {#t}{=TFlags}t: TFlags = [Green,Gray];');
|
||||
Add(' {#Chars}{=TChars}Chars: TChars;');
|
||||
Add(' {#MyInts}{=TMyInts}MyInts: TMyInts;');
|
||||
Add(' {#MyBools}{=TMyBools}MyBools: TMyBools;');
|
||||
Add('begin');
|
||||
Add(' {@s}s:=[];');
|
||||
Add(' {@s}s:=[{@Red}Red]+[{@Blue}Blue,{@Gray}Gray];');
|
||||
Add(' {@s}s:=[{@Blue}Blue,{@Gray}Gray]-[{@Blue}Blue];');
|
||||
Add(' {@s}s:={@t}t+[];');
|
||||
Add(' {@s}s:=[{@Red}Red]+{@s}s;');
|
||||
Add(' {@s}s:={@s}s+[{@Red}Red];');
|
||||
Add(' {@s}s:=[{@Red}Red]-{@s}s;');
|
||||
Add(' {@s}s:={@s}s-[{@Red}Red];');
|
||||
Add(' Include({@s}s,{@Blue}Blue);');
|
||||
Add(' Include({@s}s,{@f}f);');
|
||||
Add(' Exclude({@s}s,{@Blue}Blue);');
|
||||
Add(' Exclude({@s}s,{@f}f);');
|
||||
Add(' {@s}s:={@s}s+[{@f}f];');
|
||||
Add(' if {@Green}Green in {@s}s then ;');
|
||||
Add(' if {@Blue}Blue in {@Colors}Colors then ;');
|
||||
Add(' if {@f}f in {@ExtColors}ExtColors then ;');
|
||||
Add(' {@s}s:={@s}s * {@Colors}Colors;');
|
||||
Add(' {@s}s:={@Colors}Colors * {@s}s;');
|
||||
Add(' {@s}s:={@ExtColors}ExtColors * {@Colors}Colors;');
|
||||
Add(' {@s}s:=Colors >< {@ExtColors}ExtColors;');
|
||||
Add(' {@s}s:={@s}s >< {@ExtColors}ExtColors;');
|
||||
Add(' {@s}s:={@ExtColors}ExtColors >< s;');
|
||||
Add(' {@s}s:={@s}s >< {@s}s;');
|
||||
Add(' if ''p'' in [''a''..''z''] then ; ');
|
||||
Add(' if ''p'' in [''a''..''z'',''A''..''Z'',''0''..''9'',''_''] then ; ');
|
||||
Add(' if ''p'' in {@Chars}Chars then ; ');
|
||||
Add(' if 7 in {@MyInts}MyInts then ; ');
|
||||
Add(' if 7 in [1+2,(3*4)+5,(-2+6)..(8-3)] then ; ');
|
||||
Add(' if [red,blue]*s=[red,blue] then ;');
|
||||
Add(' if {@s}s = t then;');
|
||||
Add(' if {@s}s = {@Colors}Colors then;');
|
||||
Add(' if {@Colors}Colors = s then;');
|
||||
Add(' if {@s}s <> t then;');
|
||||
Add(' if {@s}s <> {@Colors}Colors then;');
|
||||
Add(' if {@Colors}Colors <> s then;');
|
||||
Add(' if {@s}s <= t then;');
|
||||
Add(' if {@s}s <= {@Colors}Colors then;');
|
||||
Add(' if {@Colors}Colors <= s then;');
|
||||
Add(' if {@s}s >= t then;');
|
||||
Add(' if {@s}s >= {@Colors}Colors then;');
|
||||
Add(' if {@Colors}Colors >= {@s}s then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -1681,6 +1756,23 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestSetFunctions;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (red, green, blue);');
|
||||
Add(' TFlags = set of TFlag;');
|
||||
Add('var');
|
||||
Add(' e: TFlag;');
|
||||
Add(' s: TFlags;');
|
||||
Add('begin');
|
||||
Add(' e:=Low(TFlags);');
|
||||
Add(' e:=Low(s);');
|
||||
Add(' e:=High(TFlags);');
|
||||
Add(' e:=High(s);');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestEnumHighLow;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1692,6 +1784,52 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestEnumOrd;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (red, green, blue);');
|
||||
Add('var');
|
||||
Add(' f: TFlag;');
|
||||
Add(' i: longint;');
|
||||
Add('begin');
|
||||
Add(' i:=ord(f);');
|
||||
Add(' i:=ord(green);');
|
||||
Add(' if i=ord(f) then ;');
|
||||
Add(' if ord(f)=i then ;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestEnumPredSucc;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (red, green, blue);');
|
||||
Add('var');
|
||||
Add(' f: TFlag;');
|
||||
Add('begin');
|
||||
Add(' f:=Pred(f);');
|
||||
Add(' if Pred(green)=Pred(TFlag.Blue) then;');
|
||||
Add(' f:=Succ(f);');
|
||||
Add(' if Succ(green)=Succ(TFlag.Blue) then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestEnum_CastIntegerToEnum;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TFlag = (red, green, blue);');
|
||||
Add('var');
|
||||
Add(' f: TFlag;');
|
||||
Add(' i: longint;');
|
||||
Add('begin');
|
||||
Add(' f:=TFlag(1);');
|
||||
Add(' f:=TFlag(i);');
|
||||
Add(' if TFlag(i)=TFlag(1) then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPrgAssignment;
|
||||
var
|
||||
El: TPasElement;
|
||||
@ -1914,6 +2052,12 @@ begin
|
||||
Add(' i:=j or k;');
|
||||
Add(' i:=j and not k;');
|
||||
Add(' i:=(j+k) div 3;');
|
||||
Add(' if i=j then;');
|
||||
Add(' if i<>j then;');
|
||||
Add(' if i>j then;');
|
||||
Add(' if i>=j then;');
|
||||
Add(' if i<j then;');
|
||||
Add(' if i<=j then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -1931,6 +2075,9 @@ begin
|
||||
Add(' i:=(not j) or k;');
|
||||
Add(' i:=j or false;');
|
||||
Add(' i:=j and true;');
|
||||
Add(' i:=j xor k;');
|
||||
Add(' i:=j=k;');
|
||||
Add(' i:=j<>k;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -2794,6 +2941,17 @@ begin
|
||||
PasResolver.nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcArgDefaultValueTypeMismatch;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure Proc1(a: string = 3);');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
CheckResolverException('Incompatible types: got "Longint" expected "String"',
|
||||
PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestBuiltInProcCallMissingParams;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -3958,18 +4116,23 @@ begin
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' constructor Create;');
|
||||
Add(' class function DoSome: TObject;');
|
||||
Add(' end;');
|
||||
Add('constructor TObject.Create;');
|
||||
Add('begin');
|
||||
Add(' {#a}Create; // normal call');
|
||||
Add(' TObject.{#b}Create; // new object');
|
||||
Add(' TObject.{#b}Create; // new instance');
|
||||
Add('end;');
|
||||
Add('class function TObject.DoSome: TObject;');
|
||||
Add('begin');
|
||||
Add(' Result:={#c}Create; // new instance');
|
||||
Add('end;');
|
||||
Add('var');
|
||||
Add(' o: TObject;');
|
||||
Add('begin');
|
||||
Add(' TObject.{#c}Create; // new object');
|
||||
Add(' o:=TObject.{#d}Create; // new object');
|
||||
Add(' o.{#e}Create; // normal call');
|
||||
Add(' TObject.{#p}Create; // new object');
|
||||
Add(' o:=TObject.{#q}Create; // new object');
|
||||
Add(' o.{#r}Create; // normal call');
|
||||
ParseProgram;
|
||||
aMarker:=FirstSrcMarker;
|
||||
while aMarker<>nil do
|
||||
@ -3995,7 +4158,7 @@ begin
|
||||
if not ActualImplicitCallWithoutParams then
|
||||
RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
|
||||
case aMarker^.Identifier of
|
||||
'a','e':// should be normal call
|
||||
'a','r':// should be normal call
|
||||
if ActualNewInstance then
|
||||
RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
|
||||
else // should be newinstance
|
||||
@ -4239,6 +4402,8 @@ begin
|
||||
Add('begin');
|
||||
Add(' c:=nil;');
|
||||
Add(' c:=o.ClassType;');
|
||||
Add(' if c=nil then;');
|
||||
Add(' if nil=c then;');
|
||||
Add(' if c=o.ClassType then ;');
|
||||
Add(' if c<>o.ClassType then ;');
|
||||
Add(' if Assigned(o) then ;');
|
||||
@ -4892,6 +5057,77 @@ begin
|
||||
PParser.nParserPropertyArgumentsCanNotHaveDefaultValues);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProperty_Index;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' {#FItems}FItems: array of string;');
|
||||
Add(' function {#GetItems}GetItems(Index: longint): string;');
|
||||
Add(' procedure {#SetItems}SetItems(Index: longint; Value: string);');
|
||||
Add(' procedure DoIt;');
|
||||
Add(' property {#Items}Items[Index: longint]: string read {@GetItems}getitems write {@SetItems}setitems;');
|
||||
Add(' end;');
|
||||
Add('function tobject.getitems(index: longint): string;');
|
||||
Add('begin');
|
||||
Add(' Result:={@FItems}fitems[index];');
|
||||
Add('end;');
|
||||
Add('procedure tobject.setitems(index: longint; value: string);');
|
||||
Add('begin');
|
||||
Add(' {@FItems}fitems[index]:=value;');
|
||||
Add('end;');
|
||||
Add('procedure tobject.doit;');
|
||||
Add('begin');
|
||||
Add(' {@Items}items[1]:={@Items}items[2];');
|
||||
Add(' self.{@Items}items[3]:=self.{@Items}items[4];');
|
||||
Add('end;');
|
||||
Add('var Obj: tobject;');
|
||||
Add('begin');
|
||||
Add(' obj.{@Items}Items[11]:=obj.{@Items}Items[12];');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' function GetItems(Index: string): string;');
|
||||
Add(' property Items[Index: string]: string read getitems;');
|
||||
Add(' end;');
|
||||
Add('function tobject.getitems(index: string): string;');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('var Obj: tobject;');
|
||||
Add('begin');
|
||||
Add(' obj.Items[3]:=4;');
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "Index:String"',
|
||||
PasResolver.nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProperty_Option_ClassPropertyNonStatic;
|
||||
begin
|
||||
ResolverEngine.Options:=ResolverEngine.Options+[proClassPropertyNonStatic];
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' class function GetB: longint;');
|
||||
Add(' class procedure SetB(Value: longint);');
|
||||
Add(' class property B: longint read GetB write SetB;');
|
||||
Add(' end;');
|
||||
Add('class function TObject.GetB: longint;');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('class procedure TObject.SetB(Value: longint);');
|
||||
Add('begin');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
Add(' TObject.B:=4;');
|
||||
Add(' if TObject.B=6 then;');
|
||||
Add(' if 7=TObject.B then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestDefaultProperty;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -4915,6 +5151,19 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestMissingDefaultProperty;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' end;');
|
||||
Add('var o: TObject;');
|
||||
Add('begin');
|
||||
Add(' if o[5]=6 then;');
|
||||
CheckResolverException('illegal qualifier "["',
|
||||
PasResolver.nIllegalQualifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyAssign;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -5073,11 +5322,15 @@ begin
|
||||
Add('type TIntArray = array of longint;');
|
||||
Add('var a: TIntArray;');
|
||||
Add('begin');
|
||||
Add(' a:=nil;');
|
||||
Add(' if a=nil then ;');
|
||||
Add(' if nil=a then ;');
|
||||
Add(' SetLength(a,3);');
|
||||
Add(' a[0]:=1;');
|
||||
Add(' a[1]:=length(a);');
|
||||
Add(' a[2]:=a[0];');
|
||||
Add(' if a[3]=a[4] then ;');
|
||||
Add(' a[a[5]]:=a[a[6]];');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -5150,6 +5403,35 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestPropertyOfTypeArray;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TArray = array of longint;');
|
||||
Add(' TObject = class');
|
||||
Add(' FItems: TArray;');
|
||||
Add(' function GetItems: TArray;');
|
||||
Add(' procedure SetItems(Value: TArray);');
|
||||
Add(' property Items: TArray read FItems write FItems;');
|
||||
Add(' property Numbers: TArray read GetItems write SetItems;');
|
||||
Add(' end;');
|
||||
Add('function TObject.GetItems: TArray;');
|
||||
Add('begin');
|
||||
Add(' Result:=FItems;');
|
||||
Add('end;');
|
||||
Add('procedure TObject.SetItems(Value: TArray);');
|
||||
Add('begin');
|
||||
Add(' FItems:=Value;');
|
||||
Add('end;');
|
||||
Add('var Obj: TObject;');
|
||||
Add('begin');
|
||||
Add(' Obj.Items[3]:=4;');
|
||||
Add(' if Obj.Items[5]=6 then;');
|
||||
Add(' Obj.Numbers[7]:=8;');
|
||||
Add(' if Obj.Numbers[9]=10 then;');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcTypesAssignObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user