mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 07:09:17 +02:00
fcl-passrc: resolver: array of const
git-svn-id: trunk@41326 -
This commit is contained in:
Mattias Gaertner
parent
cd03f5326d
commit
28e509f8f9
@ -183,6 +183,7 @@ const
|
||||
nHelpersCannotBeUsedAsTypes = 3117;
|
||||
nBitWiseOperationsAre32Bit = 3118;
|
||||
nImplictConversionUnicodeToAnsi = 3119;
|
||||
nWrongTypeXInArrayConstructor = 3120;
|
||||
|
||||
// using same IDs as FPC
|
||||
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
||||
@ -313,6 +314,7 @@ resourcestring
|
||||
sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
|
||||
sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
|
||||
sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
|
||||
sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
|
||||
|
||||
type
|
||||
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
||||
|
||||
@ -745,11 +745,13 @@ type
|
||||
FAssertMsgConstructor: TPasConstructor;
|
||||
FRangeErrorClass: TPasClassType;
|
||||
FRangeErrorConstructor: TPasConstructor;
|
||||
FSystemTVarRec: TPasRecordType;
|
||||
procedure SetAssertClass(const AValue: TPasClassType);
|
||||
procedure SetAssertDefConstructor(const AValue: TPasConstructor);
|
||||
procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
|
||||
procedure SetRangeErrorClass(const AValue: TPasClassType);
|
||||
procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
|
||||
procedure SetSystemTVarRec(const AValue: TPasRecordType);
|
||||
public
|
||||
FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
|
||||
PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
|
||||
@ -765,6 +767,7 @@ type
|
||||
property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
|
||||
property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
|
||||
property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
|
||||
property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
|
||||
end;
|
||||
TPasModuleScopeClass = class of TPasModuleScope;
|
||||
|
||||
@ -1228,7 +1231,7 @@ type
|
||||
ExprEl: TPasExpr;
|
||||
Flags: TPasResolverResultFlags;
|
||||
end;
|
||||
PPasResolvedElement = ^TPasResolverResult;
|
||||
PPasResolverResult = ^TPasResolverResult;
|
||||
|
||||
type
|
||||
TPasResolverComputeFlag = (
|
||||
@ -1528,10 +1531,11 @@ type
|
||||
procedure FinishArgument(El: TPasArgument); virtual;
|
||||
procedure FinishAncestors(aClass: TPasClassType); virtual;
|
||||
procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
|
||||
procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
|
||||
procedure FinishPropertyParamAccess(Params: TParamsExpr;
|
||||
Prop: TPasProperty);
|
||||
procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess);
|
||||
procedure FinishInitialFinalization(El: TPasImplBlock);
|
||||
Prop: TPasProperty); virtual;
|
||||
procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
|
||||
procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
|
||||
procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
|
||||
function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
|
||||
procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
|
||||
@ -1604,6 +1608,8 @@ type
|
||||
ErrorEl: TPasElement): boolean; virtual;
|
||||
procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
|
||||
procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
|
||||
function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
|
||||
function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
|
||||
protected
|
||||
fExprEvaluator: TResExprEvaluator;
|
||||
procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
|
||||
@ -1999,6 +2005,8 @@ type
|
||||
function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
|
||||
function IsOpenArray(TypeEl: TPasType): boolean;
|
||||
function IsDynOrOpenArray(TypeEl: TPasType): boolean;
|
||||
function IsArrayOfConst(TypeEl: TPasType): boolean;
|
||||
function GetArrayElType(ArrType: TPasArrayType): TPasType;
|
||||
function IsVarInit(Expr: TPasExpr): boolean;
|
||||
function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
|
||||
function IsClassMethod(El: TPasElement): boolean;
|
||||
@ -3713,6 +3721,16 @@ begin
|
||||
FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
|
||||
end;
|
||||
|
||||
procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
|
||||
begin
|
||||
if FSystemTVarRec=AValue then Exit;
|
||||
if FSystemTVarRec<>nil then
|
||||
FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
|
||||
FSystemTVarRec:=AValue;
|
||||
if FSystemTVarRec<>nil then
|
||||
FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
|
||||
end;
|
||||
|
||||
constructor TPasModuleScope.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -3726,6 +3744,7 @@ begin
|
||||
AssertMsgConstructor:=nil;
|
||||
RangeErrorClass:=nil;
|
||||
RangeErrorConstructor:=nil;
|
||||
SystemTVarRec:=nil;
|
||||
FreeAndNil(PendingResolvers);
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -5406,6 +5425,8 @@ begin
|
||||
RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
|
||||
if not (Parent.Parent is TPasDeclarations) then
|
||||
RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
|
||||
if El.Parent<>Parent then
|
||||
RaiseNotYetImplemented(20190215085011,Parent);
|
||||
// give anonymous sub type a name
|
||||
El.Name:=Parent.Name+AnonymousElTypePostfix;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
@ -5729,9 +5750,17 @@ begin
|
||||
RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
|
||||
end;
|
||||
if El.ElType=nil then
|
||||
RaiseNotYetImplemented(20171005235610,El,'array of const');
|
||||
CheckUseAsType(El.ElType,20190123095401,El);
|
||||
FinishSubElementType(El,El.ElType);
|
||||
begin
|
||||
// array of const
|
||||
if length(El.Ranges)>0 then
|
||||
RaiseNotYetImplemented(20190215102529,El);
|
||||
FindTVarRec(El);
|
||||
end
|
||||
else
|
||||
begin
|
||||
CheckUseAsType(El.ElType,20190123095401,El);
|
||||
FinishSubElementType(El,El.ElType);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishResourcestring(El: TPasResString);
|
||||
@ -7452,6 +7481,27 @@ begin
|
||||
// El.ImplementationProc is resolved in FinishClassType
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
|
||||
Params: TParamsExpr);
|
||||
var
|
||||
ParamAccess: TResolvedRefAccess;
|
||||
i: Integer;
|
||||
ArrParams: TPasExprArray;
|
||||
begin
|
||||
ArrParams:=Params.Params;
|
||||
for i:=0 to length(ArrParams)-1 do
|
||||
begin
|
||||
ParamAccess:=rraRead;
|
||||
if i<ProcType.Args.Count then
|
||||
case TPasArgument(ProcType.Args[i]).Access of
|
||||
argVar: ParamAccess:=rraVarParam;
|
||||
argOut: ParamAccess:=rraOutParam;
|
||||
end;
|
||||
AccessExpr(ArrParams[i],ParamAccess);
|
||||
end;
|
||||
CheckCallProcCompatibility(ProcType,Params,false,true);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
|
||||
Prop: TPasProperty);
|
||||
var
|
||||
@ -8064,7 +8114,7 @@ var
|
||||
InRange, VarRange: TResEvalValue;
|
||||
InRangeInt, VarRangeInt: TResEvalRangeInt;
|
||||
bt: TResolverBaseType;
|
||||
TypeEl: TPasType;
|
||||
TypeEl, ElType: TPasType;
|
||||
C: TClass;
|
||||
begin
|
||||
CreateScope(Loop,TPasForLoopScope);
|
||||
@ -8150,7 +8200,8 @@ begin
|
||||
C:=TypeEl.ClassType;
|
||||
if C=TPasArrayType then
|
||||
begin
|
||||
ComputeElement(TPasArrayType(TypeEl).ElType,StartResolved,[rcType]);
|
||||
ElType:=GetArrayElType(TPasArrayType(TypeEl));
|
||||
ComputeElement(ElType,StartResolved,[rcType]);
|
||||
StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
|
||||
if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
|
||||
RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
|
||||
@ -9080,8 +9131,8 @@ begin
|
||||
ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
|
||||
if IsProcedureType(ResolvedEl,true) then
|
||||
begin
|
||||
CheckCallProcCompatibility(TPasProcedureType(ResolvedEl.LoTypeEl),Params,true);
|
||||
CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
|
||||
FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
|
||||
exit;
|
||||
end
|
||||
end;
|
||||
@ -9095,31 +9146,6 @@ end;
|
||||
procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
|
||||
Params: TParamsExpr; Access: TResolvedRefAccess);
|
||||
|
||||
procedure FinishProcParams(ProcType: TPasProcedureType);
|
||||
var
|
||||
ParamAccess: TResolvedRefAccess;
|
||||
i: Integer;
|
||||
begin
|
||||
if not (Access in [rraRead,rraParamToUnknownProc]) then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveFuncParamsExpr.FinishProcParams Params=',GetObjName(Params),' NameEl=',GetObjName(NameExpr),' Access=',Access);
|
||||
{$ENDIF}
|
||||
RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
|
||||
end;
|
||||
for i:=0 to length(Params.Params)-1 do
|
||||
begin
|
||||
ParamAccess:=rraRead;
|
||||
if i<ProcType.Args.Count then
|
||||
case TPasArgument(ProcType.Args[i]).Access of
|
||||
argVar: ParamAccess:=rraVarParam;
|
||||
argOut: ParamAccess:=rraOutParam;
|
||||
end;
|
||||
AccessExpr(Params.Params[i],ParamAccess);
|
||||
end;
|
||||
CheckCallProcCompatibility(ProcType,Params,false,true);
|
||||
end;
|
||||
|
||||
procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
|
||||
var
|
||||
i: Integer;
|
||||
@ -9243,8 +9269,17 @@ begin
|
||||
|
||||
// set param expression Access flags
|
||||
if FoundEl is TPasProcedure then
|
||||
begin
|
||||
// now it is known which overloaded proc to call
|
||||
FinishProcParams(TPasProcedure(FoundEl).ProcType)
|
||||
if not (Access in [rraRead,rraParamToUnknownProc]) then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
|
||||
{$ENDIF}
|
||||
RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
|
||||
end;
|
||||
FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
|
||||
end
|
||||
else if FoundEl is TPasType then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(TPasType(FoundEl));
|
||||
@ -9307,7 +9342,14 @@ begin
|
||||
TypeEl:=ResolvedEl.LoTypeEl;
|
||||
if TypeEl is TPasProcedureType then
|
||||
begin
|
||||
FinishProcParams(TPasProcedureType(TypeEl));
|
||||
if not (Access in [rraRead,rraParamToUnknownProc]) then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
|
||||
{$ENDIF}
|
||||
RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
|
||||
end;
|
||||
FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
|
||||
exit;
|
||||
end;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
@ -9912,6 +9954,8 @@ procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
|
||||
inc(RgIndex);
|
||||
if RgIndex>length(ArrayType.Ranges) then
|
||||
begin
|
||||
if ArrayType.ElType=nil then
|
||||
exit; // elements are not arrays
|
||||
ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
|
||||
if (ResolvedElType.BaseType=btContext)
|
||||
and (ResolvedElType.LoTypeEl is TPasArrayType) then
|
||||
@ -11337,7 +11381,7 @@ procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
|
||||
end;
|
||||
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
TypeEl, ElType: TPasType;
|
||||
ArrayEl: TPasArrayType;
|
||||
ArgNo: Integer;
|
||||
OrigResolved: TPasResolverResult;
|
||||
@ -11426,7 +11470,8 @@ begin
|
||||
ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
|
||||
until false;
|
||||
OrigResolved:=ResolvedEl;
|
||||
ComputeElement(ArrayEl.ElType,ResolvedEl,Flags,StartEl);
|
||||
ElType:=GetArrayElType(ArrayEl);
|
||||
ComputeElement(ElType,ResolvedEl,Flags,StartEl);
|
||||
// identifier and value is the array itself
|
||||
ResolvedEl.IdentEl:=OrigResolved.IdentEl;
|
||||
ResolvedEl.ExprEl:=OrigResolved.ExprEl;
|
||||
@ -12710,6 +12755,51 @@ begin
|
||||
ModScope.RangeErrorConstructor:=aConstructor;
|
||||
end;
|
||||
|
||||
function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
|
||||
var
|
||||
aMod, UtilsMod: TPasModule;
|
||||
SectionScope: TPasSectionScope;
|
||||
Identifier: TPasIdentifier;
|
||||
El: TPasElement;
|
||||
ModScope: TPasModuleScope;
|
||||
begin
|
||||
aMod:=RootElement;
|
||||
ModScope:=aMod.CustomData as TPasModuleScope;
|
||||
Result:=ModScope.SystemTVarRec;
|
||||
if Result<>nil then exit;
|
||||
|
||||
// find unit in uses clauses
|
||||
UtilsMod:=FindUsedUnit('system',aMod);
|
||||
if UtilsMod=nil then
|
||||
RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
|
||||
|
||||
// find class in interface
|
||||
if UtilsMod.InterfaceSection=nil then
|
||||
RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
|
||||
|
||||
SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
|
||||
Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
|
||||
if Identifier=nil then
|
||||
RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
|
||||
El:=Identifier.Element;
|
||||
if not (El is TPasRecordType) then
|
||||
RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
|
||||
Result:=TPasRecordType(El);
|
||||
ModScope.SystemTVarRec:=Result;
|
||||
end;
|
||||
|
||||
function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
|
||||
var
|
||||
aModule: TPasModule;
|
||||
ModScope: TPasModuleScope;
|
||||
begin
|
||||
aModule:=El.GetModule;
|
||||
ModScope:=aModule.CustomData as TPasModuleScope;
|
||||
Result:=ModScope.SystemTVarRec;
|
||||
if Result=nil then
|
||||
RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
|
||||
end;
|
||||
|
||||
procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
|
||||
const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
|
||||
const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
|
||||
@ -14580,6 +14670,8 @@ var
|
||||
Param: TPasExpr;
|
||||
ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
|
||||
i: Integer;
|
||||
ArrType: TPasArrayType;
|
||||
ElType: TPasType;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
|
||||
@ -14598,7 +14690,11 @@ begin
|
||||
if ParamResolved.BaseType=btContext then
|
||||
begin
|
||||
if IsDynArray(ParamResolved.LoTypeEl) then
|
||||
ComputeElement(TPasArrayType(ParamResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
|
||||
begin
|
||||
ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
|
||||
ElType:=GetArrayElType(ArrType);
|
||||
ComputeElement(ElType,ElTypeResolved,[rcType]);
|
||||
end;
|
||||
end
|
||||
else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
|
||||
SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
|
||||
@ -14793,6 +14889,8 @@ var
|
||||
Params: TParamsExpr;
|
||||
Param, ItemParam: TPasExpr;
|
||||
ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
|
||||
ArrType: TPasArrayType;
|
||||
ElType: TPasType;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
|
||||
@ -14817,7 +14915,9 @@ begin
|
||||
if (ParamResolved.BaseType<>btContext)
|
||||
or not IsDynArray(ParamResolved.LoTypeEl) then
|
||||
exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
|
||||
ComputeElement(TPasArrayType(ParamResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
|
||||
ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
|
||||
ElType:=GetArrayElType(ArrType);
|
||||
ComputeElement(ElType,ElTypeResolved,[rcType]);
|
||||
if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
|
||||
exit(cIncompatible);
|
||||
|
||||
@ -14837,6 +14937,7 @@ var
|
||||
P: TPasExprArray;
|
||||
Param0, Param1: TPasExpr;
|
||||
ArrayResolved, ElTypeResolved: TPasResolverResult;
|
||||
ElType: TPasType;
|
||||
begin
|
||||
if Proc=nil then ;
|
||||
P:=Params.Params;
|
||||
@ -14853,7 +14954,8 @@ begin
|
||||
if (ArrayResolved.BaseType<>btContext)
|
||||
or not IsDynArray(ArrayResolved.LoTypeEl) then
|
||||
RaiseNotYetImplemented(20180622144039,Param1);
|
||||
ComputeElement(TPasArrayType(ArrayResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
|
||||
ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
|
||||
ComputeElement(ElType,ElTypeResolved,[rcType]);
|
||||
if (ElTypeResolved.BaseType=btContext)
|
||||
and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
|
||||
MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
|
||||
@ -18082,7 +18184,7 @@ begin
|
||||
exit(false);
|
||||
if length(Arr1.Ranges)>0 then
|
||||
RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
|
||||
Result:=CheckElTypeCompatibility(Arr1.ElType,Arr2.ElType,ResolveAlias);
|
||||
Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -19574,9 +19676,14 @@ begin
|
||||
ArrayEl:=TPasArrayType(T.LoTypeEl);
|
||||
if length(ArrayEl.Ranges)=0 then
|
||||
begin
|
||||
Result:='array of '+ArrayEl.ElType.Name;
|
||||
if IsOpenArray(ArrayEl) then
|
||||
Result:='open '+Result;
|
||||
if ArrayEl.ElType=nil then
|
||||
Result:='array of const'
|
||||
else
|
||||
begin
|
||||
Result:='array of '+ArrayEl.ElType.Name;
|
||||
if IsOpenArray(ArrayEl) then
|
||||
Result:='open '+Result;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result:='static array[] of '+ArrayEl.ElType.Name;
|
||||
@ -19610,6 +19717,8 @@ function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): str
|
||||
begin
|
||||
if length(TPasArrayType(aType).Ranges)>0 then
|
||||
Result:='static array'
|
||||
else if TPasArrayType(aType).ElType=nil then
|
||||
Result:='array of const'
|
||||
else if IsOpenArray(aType) then
|
||||
Result:='open array'
|
||||
else
|
||||
@ -19900,12 +20009,13 @@ var
|
||||
SrcResolved, DstResolved: TPasResolverResult;
|
||||
LArray, RArray: TPasArrayType;
|
||||
GotDesc, ExpDesc: String;
|
||||
CurTVarRec: TPasRecordType;
|
||||
|
||||
function RaiseIncompatType: integer;
|
||||
function RaiseIncompatType(Id: TMaxPrecInt): integer;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not RaiseOnIncompatible then exit;
|
||||
RaiseIncompatibleTypeRes(20170216152505,nIncompatibleTypesGotExpected,
|
||||
RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
|
||||
[],RHS,LHS,ErrorEl);
|
||||
end;
|
||||
|
||||
@ -19932,7 +20042,7 @@ begin
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
if not (rrfReadable in RHS.Flags) then
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112914));
|
||||
if TPasClassType(LTypeEl).ObjKind=TPasClassType(RTypeEl).ObjKind then
|
||||
Result:=CheckSrcIsADstType(RHS,LHS)
|
||||
else if TPasClassType(LTypeEl).ObjKind=okInterface then
|
||||
@ -19950,7 +20060,7 @@ begin
|
||||
[],RTypeEl,LTypeEl,ErrorEl);
|
||||
end
|
||||
else
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112919));
|
||||
end
|
||||
else if LTypeEl.ClassType=TPasClassOfType then
|
||||
begin
|
||||
@ -20020,15 +20130,7 @@ begin
|
||||
begin
|
||||
// DynOrOpenArr:=array
|
||||
RArray:=TPasArrayType(RTypeEl);
|
||||
if length(RArray.Ranges)>1 then
|
||||
begin
|
||||
// DynOrOpenArr:=MultiDimStaticArr -> no
|
||||
if RaiseOnIncompatible then
|
||||
RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
|
||||
[],'multi dimensional static array','dynamic array',ErrorEl);
|
||||
exit(cIncompatible);
|
||||
end
|
||||
else if length(RArray.Ranges)>0 then
|
||||
if length(RArray.Ranges)=1 then
|
||||
begin
|
||||
// DynOrOpenArr:=SingleDimStaticArr
|
||||
if (msDelphi in CurrentParser.CurrentModeswitches)
|
||||
@ -20042,6 +20144,14 @@ begin
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
end
|
||||
else if length(RArray.Ranges)>1 then
|
||||
begin
|
||||
// DynOrOpenArr:=MultiDimStaticArr -> no
|
||||
if RaiseOnIncompatible then
|
||||
RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
|
||||
[],'multi dimensional static array','dynamic array',ErrorEl);
|
||||
exit(cIncompatible);
|
||||
end
|
||||
else if not (proOpenAsDynArrays in Options) then
|
||||
begin
|
||||
if IsOpenArray(LArray) then
|
||||
@ -20061,16 +20171,33 @@ begin
|
||||
and (LArray<>RArray) then
|
||||
begin
|
||||
// Delphi does not allow assigning arrays with same element types
|
||||
if RaiseOnIncompatible then
|
||||
RaiseIncompatibleTypeRes(20180620115515,nIncompatibleTypesGotExpected,
|
||||
[],RHS,LHS,ErrorEl);
|
||||
exit(cIncompatible);
|
||||
exit(RaiseIncompatType(20190215112626));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// check element type
|
||||
if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
|
||||
if LArray.ElType=nil then
|
||||
begin
|
||||
// ArrayOfConst:=SingleDimArr
|
||||
if RArray.ElType=nil then
|
||||
// ArrayOfConst:=ArrayOfConst
|
||||
Result:=cExact
|
||||
else
|
||||
begin
|
||||
CurTVarRec:=GetTVarRec(LArray);
|
||||
if ResolveAliasType(RArray.ElType)=CurTVarRec then
|
||||
// ArrayOfConst:=ArrayOfTVarRec
|
||||
Result:=cExact
|
||||
else
|
||||
// ArrayOfConst:=SingleDimArr
|
||||
exit(RaiseIncompatType(20190215112715));
|
||||
end;
|
||||
end
|
||||
else if RArray.ElType=nil then
|
||||
// ArrayOfNonConst:=ArrayOfConst
|
||||
exit(RaiseIncompatType(20190215112907))
|
||||
else if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
|
||||
Result:=cExact
|
||||
else if RaiseOnIncompatible then
|
||||
begin
|
||||
@ -20118,7 +20245,7 @@ begin
|
||||
exit(cIncompatible);
|
||||
end
|
||||
else
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112924));
|
||||
end
|
||||
else if LTypeEl.ClassType=TPasPointerType then
|
||||
begin
|
||||
@ -20128,7 +20255,7 @@ begin
|
||||
Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
|
||||
TPasPointerType(RTypeEl).DestType,ErrorEl,false);
|
||||
if Result=cIncompatible then
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112927));
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -20139,9 +20266,9 @@ begin
|
||||
{$ENDIF}
|
||||
|
||||
if Result=-1 then
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112931));
|
||||
if not (rrfReadable in RHS.Flags) then
|
||||
exit(RaiseIncompatType);
|
||||
exit(RaiseIncompatType(20190215112934));
|
||||
end;
|
||||
|
||||
function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
|
||||
@ -20356,9 +20483,9 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
|
||||
exit;
|
||||
end;
|
||||
// dynarr:=dynarr -> check element type
|
||||
ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
|
||||
ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
|
||||
Include(ElTypeResolved.Flags,rrfWritable);
|
||||
ComputeElement(RArrayType.ElType,ValueResolved,[rcType]);
|
||||
ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
|
||||
Include(ValueResolved.Flags,rrfReadable);
|
||||
Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
|
||||
exit;
|
||||
@ -20540,6 +20667,12 @@ begin
|
||||
if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
|
||||
RaiseInternalError(20170222230012);
|
||||
LArrType:=TPasArrayType(LHS.LoTypeEl);
|
||||
if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
|
||||
and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
|
||||
begin
|
||||
// ArrayOfConst:=[]
|
||||
exit(cExact);
|
||||
end;
|
||||
|
||||
CheckRange(LArrType,0,RHS,ErrorEl);
|
||||
|
||||
@ -21101,7 +21234,7 @@ function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
|
||||
ElTypeResolved.BaseType:=btNone;
|
||||
exit(true);
|
||||
end;
|
||||
ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
|
||||
ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
|
||||
if (ElTypeResolved.BaseType<>btContext)
|
||||
or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
|
||||
exit(false);
|
||||
@ -22082,6 +22215,8 @@ begin
|
||||
exit(false);
|
||||
if length(TPasArrayType(TypeEl).Ranges)<>0 then
|
||||
exit(false);
|
||||
if TPasArrayType(TypeEl).ElType=nil then
|
||||
exit(true);// array of const is a dynamic array of TVarRec
|
||||
if OptionalOpenArray and (proOpenAsDynArrays in Options) then
|
||||
Result:=true
|
||||
else
|
||||
@ -22094,7 +22229,8 @@ begin
|
||||
and (TypeEl.ClassType=TPasArrayType)
|
||||
and (length(TPasArrayType(TypeEl).Ranges)=0)
|
||||
and (TypeEl.Parent<>nil)
|
||||
and (TypeEl.Parent.ClassType=TPasArgument);
|
||||
and (TypeEl.Parent.ClassType=TPasArgument)
|
||||
and (TPasArrayType(TypeEl).ElType<>nil);
|
||||
end;
|
||||
|
||||
function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
|
||||
@ -22104,6 +22240,19 @@ begin
|
||||
and (length(TPasArrayType(TypeEl).Ranges)=0);
|
||||
end;
|
||||
|
||||
function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
|
||||
begin
|
||||
Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
|
||||
and (TPasArrayType(TypeEl).ElType=nil);
|
||||
end;
|
||||
|
||||
function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
|
||||
begin
|
||||
Result:=ArrType.ElType;
|
||||
if Result=nil then
|
||||
Result:=GetTVarRec(ArrType);
|
||||
end;
|
||||
|
||||
function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
|
||||
var
|
||||
C: TClass;
|
||||
|
||||
@ -250,7 +250,7 @@ type
|
||||
procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
|
||||
UseFull: boolean); virtual;
|
||||
procedure UseTypeInfo(El: TPasElement); virtual;
|
||||
procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
|
||||
function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
|
||||
procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
|
||||
procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
|
||||
procedure UseImplElement(El: TPasImplElement); virtual;
|
||||
@ -1135,7 +1135,7 @@ begin
|
||||
UseElement(El,rraNone,true);
|
||||
end;
|
||||
|
||||
procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
|
||||
function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
|
||||
|
||||
procedure UseInitFinal(ImplBlock: TPasImplBlock);
|
||||
var
|
||||
@ -1154,7 +1154,8 @@ procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
|
||||
var
|
||||
ModScope: TPasModuleScope;
|
||||
begin
|
||||
if ElementVisited(aModule,Mode) then exit;
|
||||
if ElementVisited(aModule,Mode) then exit(false);
|
||||
Result:=true;
|
||||
|
||||
{$IFDEF VerbosePasAnalyzer}
|
||||
writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
|
||||
@ -1179,6 +1180,10 @@ begin
|
||||
UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
|
||||
if ModScope.RangeErrorConstructor<>nil then
|
||||
UseProcedure(ModScope.RangeErrorConstructor);
|
||||
// no need to use here ModScope.AssertClass, it is used by Assert
|
||||
// no need to use here ModScope.AssertMsgConstructor
|
||||
// no need to use here ModScope.AssertDefConstructor
|
||||
// no need to use here ModScope.SystemTVarRec
|
||||
|
||||
if Mode=paumElement then
|
||||
// e.g. a reference: unitname.identifier
|
||||
|
||||
@ -1892,32 +1892,42 @@ begin
|
||||
case CurToken of
|
||||
tkSquaredBraceOpen:
|
||||
begin
|
||||
repeat
|
||||
NextToken;
|
||||
if po_arrayrangeexpr in Options then
|
||||
begin
|
||||
RangeExpr:=DoParseExpression(Result);
|
||||
Result.AddRange(RangeExpr);
|
||||
end
|
||||
else if CurToken<>tkSquaredBraceClose then
|
||||
S:=S+CurTokenText;
|
||||
if CurToken=tkSquaredBraceClose then
|
||||
break
|
||||
else if CurToken=tkComma then
|
||||
continue
|
||||
else if po_arrayrangeexpr in Options then
|
||||
ParseExcTokenError(']');
|
||||
until false;
|
||||
Result.IndexRange:=S;
|
||||
ExpectToken(tkOf);
|
||||
Result.ElType := ParseType(Result,CurSourcePos);
|
||||
// static array
|
||||
if Parent is TPasArgument then
|
||||
ParseExcTokenError('of');
|
||||
repeat
|
||||
NextToken;
|
||||
if po_arrayrangeexpr in Options then
|
||||
begin
|
||||
RangeExpr:=DoParseExpression(Result);
|
||||
Result.AddRange(RangeExpr);
|
||||
end
|
||||
else if CurToken<>tkSquaredBraceClose then
|
||||
S:=S+CurTokenText;
|
||||
if CurToken=tkSquaredBraceClose then
|
||||
break
|
||||
else if CurToken=tkComma then
|
||||
continue
|
||||
else if po_arrayrangeexpr in Options then
|
||||
ParseExcTokenError(']');
|
||||
until false;
|
||||
Result.IndexRange:=S;
|
||||
ExpectToken(tkOf);
|
||||
Result.ElType := ParseType(Result,CurSourcePos);
|
||||
end;
|
||||
tkOf:
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkConst then
|
||||
// array of const
|
||||
begin
|
||||
if not (Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (CurToken=tkarray) and (Parent is TPasArgument) then
|
||||
ParseExcExpectedIdentifier;
|
||||
UngetToken;
|
||||
Result.ElType := ParseType(Result,CurSourcePos);
|
||||
end;
|
||||
|
||||
@ -103,7 +103,8 @@ type
|
||||
PTestResolverReferenceData = ^TTestResolverReferenceData;
|
||||
|
||||
TSystemUnitPart = (
|
||||
supTObject
|
||||
supTObject,
|
||||
supTVarRec
|
||||
);
|
||||
TSystemUnitParts = set of TSystemUnitPart;
|
||||
|
||||
@ -800,9 +801,12 @@ type
|
||||
Procedure TestArray_ConstDynArrayWrite;
|
||||
Procedure TestArray_ConstOpenArrayWriteFail;
|
||||
Procedure TestArray_ForIn;
|
||||
Procedure TestArray_Arg_AnonymousStaticFail;
|
||||
Procedure TestArray_Arg_AnonymousMultiDimFail;
|
||||
|
||||
// array of const
|
||||
Procedure TestArrayOfConst;
|
||||
Procedure TestArrayOfConst_PassDynArrayOfIntFail;
|
||||
|
||||
// static arrays
|
||||
Procedure TestArrayIntRange_OutOfRange;
|
||||
@ -2074,6 +2078,20 @@ begin
|
||||
' function ToString: String; virtual;',
|
||||
' end;']);
|
||||
end;
|
||||
if supTVarRec in Parts then
|
||||
begin
|
||||
Intf.AddStrings([
|
||||
'const',
|
||||
' vtInteger = 0;',
|
||||
' vtBoolean = 1;',
|
||||
'type',
|
||||
' PVarRec = ^TVarRec;',
|
||||
' TVarRec = record',
|
||||
' case VType : sizeint of',
|
||||
' vtInteger : (VInteger: Longint);',
|
||||
' vtBoolean : (VBoolean: Boolean);',
|
||||
' end;']);
|
||||
end;
|
||||
Intf.Add('var');
|
||||
Intf.Add(' ExitCode: Longint = 0;');
|
||||
|
||||
@ -14324,14 +14342,74 @@ begin
|
||||
CheckParamsExpr_pkSet_Markers;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArrayOfConst;
|
||||
procedure TTestResolver.TestArray_Arg_AnonymousStaticFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure DoIt(args: array of const);',
|
||||
'begin end;',
|
||||
'procedure DoIt(args: array[1..2] of word);',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckResolverException('not yet implemented: :TPasArrayType [20171005235610] array of const',nNotYetImplemented);
|
||||
CheckParserException('Expected "of"',nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArray_Arg_AnonymousMultiDimFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure DoIt(args: array of array of word);',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckParserException(SParserExpectedIdentifier,nParserExpectedIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArrayOfConst;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'type',
|
||||
' TArrOfVarRec = array of TVarRec;',
|
||||
'procedure DoIt(args: array of const);',
|
||||
'var',
|
||||
' i: longint;',
|
||||
' v: TVarRec;',
|
||||
' a: TArrOfVarRec;',
|
||||
'begin',
|
||||
' DoIt(args);',
|
||||
' DoIt(a);',
|
||||
' DoIt([]);',
|
||||
' DoIt([1]);',
|
||||
' DoIt([i]);',
|
||||
' DoIt([true,''foo'',''c'',1.3,nil,@DoIt]);',
|
||||
' for i:=low(args) to high(args) do begin',
|
||||
' v:=args[i];',
|
||||
' case args[i].VType of',
|
||||
' vtInteger: if length(args)=args[i].VInteger then ;',
|
||||
' end;',
|
||||
' end;',
|
||||
' for v in Args do ;',
|
||||
' args:=nil;',
|
||||
' SetLength(args,2);',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArrayOfConst_PassDynArrayOfIntFail;
|
||||
begin
|
||||
StartProgram(true,[supTVarRec]);
|
||||
Add([
|
||||
'type',
|
||||
' TArr = array of word;',
|
||||
'procedure DoIt(args: array of const);',
|
||||
'begin',
|
||||
'end;',
|
||||
'var a: TArr;',
|
||||
'begin',
|
||||
' DoIt(a)']);
|
||||
CheckResolverException('Incompatible type arg no. 1: Got "TArr", expected "array of const"',
|
||||
nIncompatibleTypeArgNo);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestArrayIntRange_OutOfRange;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user