diff --git a/packages/fcl-passrc/src/pasresolveeval.pas b/packages/fcl-passrc/src/pasresolveeval.pas index 828c43a7e5..b86c9b705b 100644 --- a/packages/fcl-passrc/src/pasresolveeval.pas +++ b/packages/fcl-passrc/src/pasresolveeval.pas @@ -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 } diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 62852445d3..70d5e4fd0f 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -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 ibtContext) 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; diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index ced8765d54..58df3cddb1 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -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 diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 81becb0054..ed5d1af3da 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -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; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 35b288dbbc..529c92de44 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -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;