* Patch from Mattias gaertner:

  - type cast class-of
  - type cast Self in class method
  - bark on statement without call, e.g. "i;"
  - mode delphi procedure types
  - give each message an unique id

git-svn-id: trunk@35470 -

packages/fcl-passrc/tests/tcresolver.pas

@@ -209,12 +209,14 @@ type
     Procedure TestCaseOf;
     Procedure TestCaseExprNonOrdFail;
     Procedure TestCaseIncompatibleValueFail;
+    Procedure TestSimpleStatement_VarFail;
 
     // units
     Procedure TestUnitRef;
 
     // procs
     Procedure TestProcParam;
+    Procedure TestProcParamAccess;
     Procedure TestFunctionResult;
     Procedure TestProcOverload;
     Procedure TestProcOverloadWithBaseTypes;
@@ -243,6 +245,7 @@ type
     Procedure TestBreak;
     Procedure TestContinue;
     Procedure TestProcedureExternal;
+    // ToDo: fail builtin functions in constant with non const param
 
     // record
     Procedure TestRecord;
@@ -303,6 +306,10 @@ type
     Procedure TestClass_Constructor_Inherited;
     Procedure TestClass_SubObject;
     Procedure TestClass_WithClassInstance;
+    // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
+    // ToDo: typecast multiple params fail
+    // ToDo: use Self in non method as local var, requires changes in pparser
+    // ToDo: use Self in non method as global var, requires changes in pparser
 
     // class of
     Procedure TestClassOf;
@@ -319,6 +326,10 @@ type
     Procedure TestClass_ClassProcSelf;
     Procedure TestClass_ClassProcSelfTypeCastFail;
     Procedure TestClass_ClassMembers;
+    Procedure TestClassOf_AsFail;
+    Procedure TestClassOf_MemberAsFail;
+    Procedure TestClassOf_IsFail;
+    Procedure TestClass_TypeCast;
 
     // property
     Procedure TestProperty1;
@@ -364,15 +375,24 @@ type
     Procedure TestFunctionReturningArray;
     Procedure TestLowHighArray;
     Procedure TestPropertyOfTypeArray;
+    Procedure TestArrayElementFromFuncResult_AsParams;
+    // ToDo: const array
+    // ToDo: const array non const index fail
 
     // procedure types
     Procedure TestProcTypesAssignObjFPC;
     Procedure TestMethodTypesAssignObjFPC;
+    Procedure TestProcTypeCall;
+    Procedure TestProcType_FunctionFPC;
+    Procedure TestProcType_FunctionDelphi;
+    Procedure TestProcType_MethodFPC;
+    Procedure TestProcType_MethodDelphi;
     Procedure TestAssignProcToMethodFail;
     Procedure TestAssignMethodToProcFail;
     Procedure TestAssignProcToFunctionFail;
     Procedure TestAssignProcWrongArgsFail;
     Procedure TestArrayOfProc;
+    Procedure TestProcType_Assigned;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -2568,6 +2588,15 @@ begin
     nIncompatibleTypesGotExpected);
 end;
 
+procedure TTestResolver.TestSimpleStatement_VarFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  i;');
+  CheckResolverException('Illegal expression',nIllegalExpression);
+end;
+
 procedure TTestResolver.TestUnitRef;
 var
   El, DeclEl, OtherUnit: TPasElement;
@@ -2673,6 +2702,27 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcParamAccess;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(vI: longint; const vJ: longint; var vK: longint);');
+  Add('var vL: longint;');
+  Add('begin');
+  Add('  vi:=vi+1;');
+  Add('  vl:=vj+1;');
+  Add('  vk:=vk+1;');
+  Add('  vl:=vl+1;');
+  Add('  DoIt(vi,vi,vi);');
+  Add('  DoIt(vj,vj,vl);');
+  Add('  DoIt(vk,vk,vk);');
+  Add('  DoIt(vl,vl,vl);');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  DoIt(i,i,i);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestFunctionResult;
 begin
   StartProgram(false);
@@ -3038,7 +3088,6 @@ begin
   Add('begin');
   Add('  if {@F2}F2 then ;');
   Add('  if {@i}i={@F1}F1() then ;');
-  Add('  if {@i}i={@F1}F1 then ;');
   ParseProgram;
 end;
 
@@ -4471,14 +4520,14 @@ begin
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
     begin
-    writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    //writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
     Elements:=FindElementsAt(aMarker);
     try
       ActualRefWith:=false;
       for i:=0 to Elements.Count-1 do
         begin
         El:=TPasElement(Elements[i]);
-        writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        //writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
         if not (El.CustomData is TResolvedReference) then continue;
         Ref:=TResolvedReference(El.CustomData);
         if Ref.WithExprScope=nil then continue;
@@ -4724,13 +4773,13 @@ begin
   Add('  o: TObject;');
   Add('  oc: TObjectClass;');
   Add('begin');
-  Add('  o.A1:=3');
+  Add('  o.A1:=3;');
   Add('  if o.A1=4 then ;');
   Add('  if 5=o.A1 then ;');
-  Add('  oc.A1:=6');
+  Add('  oc.A1:=6;');
   Add('  if oc.A1=7 then ;');
   Add('  if 8=oc.A1 then ;');
-  Add('  TObject.A1:=9');
+  Add('  TObject.A1:=9;');
   Add('  if TObject.A1=10 then ;');
   Add('  if 11=TObject.A1 then ;');
   ParseProgram;
@@ -4761,12 +4810,17 @@ begin
   Add('    class var GlobalId: longint;');
   Add('    class procedure ProcA;');
   Add('  end;');
+  Add('  TClass = class of TObject;');
   Add('class procedure TObject.ProcA;');
+  Add('var c: TClass;');
   Add('begin');
   Add('  if Self=nil then ;');
   Add('  if Self.GlobalId=3 then ;');
   Add('  if 4=Self.GlobalId then ;');
   Add('  Self.GlobalId:=5;');
+  Add('  c:=Self;');
+  Add('  c:=TClass(Self);');
+  Add('  if Self=c then ;');
   Add('end;');
   Add('begin');
   ParseProgram;
@@ -4865,6 +4919,97 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClassOf_AsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  c: tclass;');
+  Add('begin');
+  Add('  c:=c as TClass;');
+  CheckResolverException('illegal qualifier "as"',nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestClassOf_MemberAsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('    c: tclass;');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.c:=o.c as TClass;');
+  CheckResolverException('illegal qualifier "as"',nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestClassOf_IsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  c: tclass;');
+  Add('begin');
+  Add('  if c is TObject then;');
+  CheckResolverException('left side of is-operator expects a class, but got "class of" type',
+    nLeftSideOfIsOperatorExpectsAClassButGot);
+end;
+
+procedure TTestResolver.TestClass_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure {#TObject_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('  TMobile = class');
+  Add('    class procedure {#TMobile_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TMobileClass = class of TMobile;');
+  Add('  TCar = class(TMobile)');
+  Add('    class procedure {#TCar_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TCarClass = class of TCar;');
+  Add('class procedure TObject.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TMobile.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(Self).{@TCar_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TCar.DoIt; begin end;');
+  Add('var');
+  Add('  ObjC: TClass;');
+  Add('  MobileC: TMobileClass;');
+  Add('  CarC: TCarClass;');
+  Add('begin');
+  Add('  ObjC.{@TObject_DoIt}DoIt;');
+  Add('  MobileC.{@TMobile_DoIt}DoIt;');
+  Add('  CarC.{@TCar_DoIt}DoIt;');
+  Add('  TClass(ObjC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(ObjC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(MobileC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(MobileC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(CarC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(CarC).{@TCar_DoIt}DoIt;');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProperty1;
 begin
   StartProgram(false);
@@ -5557,6 +5702,60 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestArrayElementFromFuncResult_AsParams;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCall: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type Integer = longint;');
+  Add('type TArrayInt = array of integer;');
+  Add('function GetArr(vB: integer = 0): tarrayint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure DoIt(vG: integer);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  doit({#a}getarr[1+1]);');
+  Add('  doit({#b}getarr()[2+1]);');
+  Add('  doit({#b}getarr(7)[3+1]);');
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestArrayElementFromFuncResult_AsParams ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCall:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestArrayElementFromFuncResult_AsParams ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCall:=true;
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a':
+        if not ActualImplicitCall then
+          RaiseErrorAtSrcMarker('expected rrfImplicitCallWithoutParams at "#'+aMarker^.Identifier+'"',aMarker);
+      else
+        if ActualImplicitCall then
+          RaiseErrorAtSrcMarker('expected no rrfImplicitCallWithoutParams at "#'+aMarker^.Identifier+'"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestProcTypesAssignObjFPC;
 begin
   StartProgram(false);
@@ -5600,6 +5799,7 @@ begin
   Add('  f:=GetNumberFunc(); // not in Delphi');
   Add('  f:=GetNumberFuncFunc()();');
   Add('  if f=f then ;');
+  Add('  if i=f then ;');
   Add('  if i=f() then ;');
   Add('  if f()=i then ;');
   Add('  if f()=f() then ;');
@@ -5643,6 +5843,7 @@ begin
   Add('    OnClick(Self);');
   Add('    Self.OnClick(nil);');
   Add('  end;');
+  Add('  if [email protected] then ;');
   Add('  if [email protected] then ;');
   Add('end;');
   Add('var o: TObject;');
@@ -5654,6 +5855,208 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcTypeCall;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCallWithoutParams: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vI: longint = 1):longint;');
+  Add('  TFuncFuncInt = function(vI: longint = 1): TFuncInt;');
+  Add('procedure DoI(vI: longint); begin end;');
+  Add('procedure DoFConst(const vI: tfuncint); begin end;');
+  Add('procedure DoFVar(var vI: tfuncint); begin end;');
+  Add('procedure DoFDefault(vI: tfuncint); begin end;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  f: tfuncint;');
+  Add('begin');
+  Add('  {#a}f;');
+  Add('  {#b}f();');
+  Add('  {#c}f(2);');
+  Add('  i:={#d}f;');
+  Add('  i:={#e}f();');
+  Add('  i:={#f}f(2);');
+  Add('  doi({#g}f);');
+  Add('  doi({#h}f());');
+  Add('  doi({#i}f(2));');
+  Add('  dofconst({#j}f);');
+  ParseProgram;
+
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestProcTypeCall ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestProcTypeCall ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        //writeln('TTestResolver.TestProcTypeCall ',GetObjName(Ref.Declaration),' rrfImplicitCallWithoutParams=',rrfImplicitCallWithoutParams in Ref.Flags);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCallWithoutParams:=true;
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a','d','g':
+        if not ActualImplicitCallWithoutParams then
+          RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+      else
+        if ActualImplicitCallWithoutParams then
+          RaiseErrorAtSrcMarker('expected no implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestProcType_FunctionFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  //Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  //Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_FunctionDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode Delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  //Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi  *)
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_MethodFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function tobject.doit(vA: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:[email protected];'); // ok in fpc and delphi
+  //Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:[email protected];'); // ok in fpc, illegal in delphi
+  Add('  b:[email protected]=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  Add('  b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_MethodDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function tobject.doit(vA: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:[email protected];'); // ok in fpc and delphi
+  Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:[email protected];'); // ok in fpc, illegal in delphi
+  //Add('  b:[email protected]=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:[email protected]<>vp;'); // ok in fpc, illegal in delphi
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestAssignProcToMethodFail;
 begin
   StartProgram(false);
@@ -5721,7 +6124,7 @@ begin
   StartProgram(false);
   Add('type');
   Add('  TObject = class end;');
-  Add('  TNotifyProc = function(Sender: TObject): longint;');
+  Add('  TNotifyProc = function(Sender: TObject = nil): longint;');
   Add('  TProcArray = array of TNotifyProc;');
   Add('function ProcA(Sender: TObject): longint;');
   Add('begin end;');
@@ -5732,6 +6135,7 @@ begin
   Add('  a[0]:=@ProcA;');
   Add('  if a[1]=@ProcA then ;');
   Add('  if @ProcA=a[2] then ;');
+  // Add('  a[3];'); ToDo
   Add('  a[3](nil);');
   Add('  if a[4](nil)=5 then ;');
   Add('  if 6=a[7](nil) then ;');
@@ -5743,6 +6147,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcType_Assigned;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(i: longint): longint;');
+  Add('function ProcA(i: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  a: array of TFuncInt;');
+  Add('  p: TFuncInt;');
+  Add('begin');
+  Add('  if Assigned(p) then ;');
+  Add('  if Assigned(a[1]) then ;');
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolver]);