fcl-passrc: resolver: assignation using constant array, + operator arrays, modeswitch arrayoperators, mode delphi: dyn arrays requires square bracket

git-svn-id: trunk@39282 -

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -717,6 +717,9 @@ procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
     if ElImplScope=nil then exit;
     RefElImplScope:=FindTopImplScope(RefEl);
     if RefElImplScope=ElImplScope then exit;
+
+    if (RefEl.Name='') and not (RefEl is TInterfaceSection) then
+      exit; // reference to anonymous type -> not needed
     if ElImplScope is TPasProcedureScope then
       TPasProcedureScope(ElImplScope).AddReference(RefEl,Access)
     else if ElImplScope is TPasInitialFinalizationScope then

packages/fcl-passrc/tests/tcresolver.pas

@@ -143,6 +143,7 @@ type
     procedure CheckResolverException(Msg: string; MsgNumber: integer);
     procedure CheckParserException(Msg: string; MsgNumber: integer);
     procedure CheckAccessMarkers; virtual;
+    procedure CheckParamsExpr_pkSet_Markers; virtual;
     procedure GetSrc(Index: integer; out SrcLines: TStringList; out aFilename: string);
     function FindElementsAt(aFilename: string; aLine, aStartCol, aEndCol: integer): TFPList;// list of TPasElement
     function FindElementsAt(aMarker: PSrcMarker; ErrorOnNoElements: boolean = true): TFPList;// list of TPasElement
@@ -685,7 +686,8 @@ type
     Procedure TestFunctionReturningArray;
     Procedure TestArray_LowHigh;
     Procedure TestArray_LowVarFail;
-    Procedure TestArray_AssignSameSignatureFail;
+    Procedure TestArray_AssignDiffElTypeFail;
+    Procedure TestArray_AssignSameSignatureDelphiFail;
     Procedure TestArray_Assigned;
     Procedure TestPropertyOfTypeArray;
     Procedure TestArrayElementFromFuncResult_AsParams;
@@ -696,7 +698,8 @@ type
     Procedure TestArrayEnumTypeConstNonConstFail;
     Procedure TestArrayEnumTypeSetLengthFail;
     Procedure TestArrayEnumCustomRange;
-    Procedure TestArray_DynArrayConst;
+    Procedure TestArray_DynArrayConstObjFPC;
+    Procedure TestArray_DynArrayConstDelphi;
     Procedure TestArray_Static_Const;
     Procedure TestArray_Record_Const;
     Procedure TestArray_MultiDim_Const;
@@ -708,10 +711,12 @@ type
     Procedure TestArray_OpenArrayOfString_IntFail;
     Procedure TestArray_OpenArrayOverride;
     Procedure TestArray_OpenArrayAsDynArraySetLengthFail;
+    Procedure TestArray_OpenArrayAsDynArray;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestArray_CopyMismatchFail;
-    Procedure TestArray_InsertDelete;
+    Procedure TestArray_InsertDeleteAccess;
+    Procedure TestArray_InsertArray;
     Procedure TestStaticArray_InsertFail;
     Procedure TestStaticArray_DeleteFail;
     Procedure TestArray_InsertItemMismatchFail;
@@ -719,6 +724,7 @@ type
     Procedure TestArray_TypeCastWrongElTypeFail;
     Procedure TestArray_ConstDynArrayWrite;
     Procedure TestArray_ConstOpenArrayWriteFail;
+    Procedure TestArray_ForIn;
 
     // array of const
     Procedure TestArrayOfConst;
@@ -1600,6 +1606,73 @@ begin
     end;
 end;
 
+procedure TCustomTestResolver.CheckParamsExpr_pkSet_Markers;
+var
+  aMarker: PSrcMarker;
+  p: SizeInt;
+  AccessPostfix: String;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  ParamsExpr: TParamsExpr;
+  NeedArray: Boolean;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.CheckParamsExpr_pkSet_Markers ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    p:=RPos('_',aMarker^.Identifier);
+    if p>1 then
+      begin
+      AccessPostfix:=copy(aMarker^.Identifier,p+1);
+      if SameText(AccessPostfix,'set') then
+        NeedArray:=false
+      else if SameText(AccessPostfix,'array') then
+        NeedArray:=true
+      else
+        RaiseErrorAtSrcMarker('unknown set/array postfix of [] expression at "#'+aMarker^.Identifier+'"',aMarker);
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        ParamsExpr:=nil;
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          //writeln('TTestResolver.CheckParamsExpr_pkSet_Markers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          if El.ClassType<>TParamsExpr then continue;
+          if ParamsExpr<>nil then
+            RaiseErrorAtSrcMarker('multiple paramsexpr found at "#'+aMarker^.Identifier+'"',aMarker);
+
+          ParamsExpr:=TParamsExpr(El);
+
+          if NeedArray then
+            begin
+            if not (El.CustomData is TResolvedReference) then
+              RaiseErrorAtSrcMarker('array expr has no TResolvedReference at "#'+aMarker^.Identifier+'"',aMarker);
+            Ref:=TResolvedReference(El.CustomData);
+            if not (Ref.Declaration is TPasArrayType) then
+              RaiseErrorAtSrcMarker('array expr Ref.Decl is not TPasArrayType (is '+GetObjName(Ref.Declaration)+') at "#'+aMarker^.Identifier+'"',aMarker);
+            end
+          else
+            begin
+            if not (El.CustomData is TResolvedReference) then
+              continue; // good
+            Ref:=TResolvedReference(El.CustomData);
+            if Ref.Declaration is TPasArrayType then
+              RaiseErrorAtSrcMarker('set expr Ref.Decl is '+GetObjName(Ref.Declaration)+' at "#'+aMarker^.Identifier+'"',aMarker);
+            end;
+          end;
+        if TParamsExpr=nil then
+          RaiseErrorAtSrcMarker('missing paramsexpr at "#'+aMarker^.Identifier+'"',aMarker);
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TCustomTestResolver.GetSrc(Index: integer; out SrcLines: TStringList; out
   aFilename: string);
 var
@@ -3688,8 +3761,12 @@ begin
   'const',
   '  a: TFiveSet = [2..3,5]+[4];',
   '  b = low(TIntRg)+high(TIntRg);',
+  '  c = [low(TIntRg)..high(TIntRg)];',
+  'var',
+  '  s: TFiveSet;',
   'begin',
-  '  if 3 in a then ;']);
+  '  if 3 in a then ;',
+  '  s:=c;']);
   ParseProgram;
   CheckResolverUnexpectedHints;
 end;
@@ -11761,11 +11838,27 @@ begin
   CheckResolverException(sConstantExpressionExpected,nConstantExpressionExpected);
 end;
 
-procedure TTestResolver.TestArray_AssignSameSignatureFail;
+procedure TTestResolver.TestArray_AssignDiffElTypeFail;
 begin
   StartProgram(false);
   Add('type');
   Add('  TArrA = array of longint;');
+  Add('  TArrB = array of byte;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('  b: TArrB;');
+  Add('begin');
+  Add('  a:=b;');
+  CheckResolverException('Incompatible types: got "array of Longint" expected "array of Byte"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_AssignSameSignatureDelphiFail;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TArrA = array of longint;');
   Add('  TArrB = array of longint;');
   Add('var');
   Add('  a: TArrA;');
@@ -11980,10 +12073,13 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestArray_DynArrayConst;
+procedure TTestResolver.TestArray_DynArrayConstObjFPC;
 begin
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Scanner.Options:=Scanner.Options+[po_cassignments];
   StartProgram(false);
   Add([
+  '{$modeswitch arrayoperators}',
   'type',
   '  integer = longint;',
   '  TArrInt = array of integer;',
@@ -11993,11 +12089,59 @@ begin
   '  Names: array of string = (''a'',''foo'');',
   '  Aliases: TarrStr = (''foo'',''b'');',
   '  OneInt: TArrInt = (7);',
-  '  OneStr: array of integer = (7);',
+  '  OneInt2: array of integer = (7);',
   '  Chars: array of char = ''aoc'';',
+  '  NameCount = low(Names)+high(Names)+length(Names);',
+  'procedure DoIt(Ints: TArrInt);',
   'begin',
+  'end;',
+  'var i: integer;',
+  'begin',
+  '  Ints:= {#a_array}[1,i];',
+  '  Ints:= {#b1_array}[1,1]+ {#b2_array}[2]+ {#b3_array}[i];',
+  '  Ints:= {#c_array}[i]+ {#d_array}[2,2];',
+  '  Ints:=Ints+ {#e_array}[1];',
+  '  Ints:= {#f_array}[1]+Ints;',
+  '  Ints:=Ints+OneInt+OneInt2;',
+  '  Ints+= {#g_array}[i];',
+  '  Ints+= {#h_array}[1,1];',
+  '  DoIt( {#i_array}[1,1]);',
+  '  DoIt( {#j_array}[i]);',
   '']);
   ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestArray_DynArrayConstDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'const c= {#c_set}[1,2];',
+  'type',
+  '  integer = longint;',
+  '  TArrInt = array of integer;',
+  '  TArrStr = array of string;',
+  '  TArrInt2 = array of TArrInt;',
+  '  TSetOfEnum = set of (red,blue);',
+  '  TArrOfSet = array of TSetOfEnum;',
+  'const',
+  '  Ints: TArrInt = {#ints_array}[1,2,1];',
+  '  Names: array of string = {#names_array}[''a'',''a''];',
+  '  Aliases: TarrStr = {#aliases_array}[''foo'',''b'',''b''];',
+  '  OneInt: TArrInt = {#oneint_array}[7];',
+  '  TwoInt: array of integer = {#twoint1_array}[7]+{#twoint2_array}[8];',
+  '  Chars: array of char = ''aoc'';',
+  '  NameCount = low(Names)+high(Names)+length(Names);',
+  'procedure {#DoArrOfSet}DoIt(const s: TArrOfSet); overload; begin end;',
+  'procedure {#DoArrOfArrInt}DoIt(const a: TArrInt2); overload; begin end;',
+  'begin',
+  '  {@DoArrOfSet}DoIt( {#a1_array}[ {#a2_set}[blue], {#a3_set}[red] ]);',
+  '  {@DoArrOfArrInt}DoIt( {#b1_array}[ {#b2_array}[1], {#b3_array}[2] ]);',
+  '']);
+  ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
   CheckResolverUnexpectedHints;
 end;
 
@@ -12044,16 +12188,32 @@ procedure TTestResolver.TestArray_MultiDim_Const;
 begin
   StartProgram(false);
   Add([
+  '{$modeswitch arrayoperators}',
   'type',
   '  TDynArray = array of longint;',
+  '  TDynArray2 = array of TDynArray;',
   '  TArrOfArr = array[1..2] of TDynArray;',
   '  TMultiDimArr = array[1..2,3..4] of longint;',
   'const',
   '  AoA: TArrOfArr = ( (1,2), (2,3) );',
   '  MultiDimArr: TMultiDimArr = ( (11,12), (13,14) );',
+  '  A2: TDynArray2 = ( (1,2), (2,3) );',
+  'var',
+  '  A: TDynArray;',
+  'procedure DoIt(const a: TDynArray2); begin end;',
+  'var i: longint;',
   'begin',
+  '  AoA:= {#a1_array}[ {#a2_array}[1], {#a3_array}[i] ];',
+  '  AoA:= {#b1_array}[ {#b2_array}[i], A ];',
+  '  AoA:= {#c1_array}[ {#c2_array}[i,2], {#c3_array}[2,i] ];',
+  '  MultiDimArr:= {#d1_array}[ {#d2_array}[11,12], [13,14] ];',
+  '  A2:= {#e1_array}[ {#e2_array}[1,2], {#e3_array}[2,3], {#e4_array}[i] ];',
+  '  DoIt( {#f1_array}[ {#f2_array}[i,32], {#f3_array}[32,i] ]);',
+  '  A2:= A2+ {#g1_array}[A];',
+  '  A2:= {#h1_array}[A]+A2;',
   '']);
   ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
 end;
 
 procedure TTestResolver.TestArray_AssignNilToStaticArrayFail1;
@@ -12065,7 +12225,7 @@ begin
   Add('  a: array[TEnum] of longint;');
   Add('begin');
   Add('  a:=nil;');
-  CheckResolverException('Incompatible types: got "Nil" expected "array type"',
+  CheckResolverException('Incompatible types: got "Nil" expected "array"',
     nIncompatibleTypesGotExpected);
 end;
 
@@ -12115,6 +12275,7 @@ procedure TTestResolver.TestArray_OpenArrayOfString;
 begin
   StartProgram(false);
   Add([
+  'type TArrStr = array of string;',
   'procedure DoIt(const a: array of String);',
   'var',
   '  i: longint;',
@@ -12127,7 +12288,8 @@ begin
   'begin',
   '  DoIt([]);',
   '  DoIt([s,''foo'','''',s+s]);',
-  '  DoIt(arr);']);
+  '  DoIt(arr);',
+  '']);
   ParseProgram;
 end;
 
@@ -12166,7 +12328,6 @@ end;
 
 procedure TTestResolver.TestArray_OpenArrayAsDynArraySetLengthFail;
 begin
-  ResolverEngine.Options:=ResolverEngine.Options+[proOpenAsDynArrays];
   StartProgram(false);
   Add([
   'procedure DoIt(a: array of byte);',
@@ -12174,29 +12335,71 @@ begin
   '  SetLength(a,3);',
   'end;',
   'begin']);
-  CheckResolverException('Incompatible type arg no. 1: Got "array of Byte", expected "string or dynamic array variable"',
+  CheckResolverException('Incompatible type arg no. 1: Got "open array of Byte", expected "string or dynamic array variable"',
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestArray_OpenArrayAsDynArray;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proOpenAsDynArrays];
+  StartProgram(false);
+  Add([
+  '{$modeswitch arrayoperators}',
+  'type TArrStr = array of string;',
+  'procedure DoStr(const a: TArrStr); forward;',
+  'procedure DoIt(a: array of String);',
+  'var',
+  '  i: longint;',
+  '  s: string;',
+  'begin',
+  '  SetLength(a,3);',
+  '  DoStr(a);',
+  '  DoStr(a+[s]);',
+  '  DoStr([s]+a);',
+  'end;',
+  'procedure DoStr(const a: TArrStr);',
+  'var s: string;',
+  'begin',
+  '  DoIt(a);',
+  '  DoIt(a+[s]);',
+  '  DoIt([s]+a);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArray_CopyConcat;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  integer = longint;');
+  '{$modeswitch arrayoperators}',
-  Add('  TArrayInt = array of integer;');
+  'type',
-  Add('function Get(A: TArrayInt): TArrayInt; begin end;');
+  '  integer = longint;',
-  Add('var');
+  '  TArrayInt = array of integer;',
-  Add('  i: integer;');
+  '  TFlag = (red, blue);',
-  Add('  A: TArrayInt;');
+  '  TArrayFlag = array of TFlag;',
-  Add('begin');
+  'function Get(A: TArrayInt): TArrayInt; begin end;',
-  Add('  A:=Copy(A);');
+  'var',
-  Add('  A:=Copy(A,1);');
+  '  i: integer;',
-  Add('  A:=Copy(A,2,3);');
+  '  A: TArrayInt;',
-  Add('  A:=Copy(Get(A),2,3);');
+  '  FA: TArrayFlag;',
-  Add('  Get(Copy(A));');
+  'begin',
-  Add('  A:=Concat(A);');
+  '  A:=Copy(A);',
-  Add('  A:=Concat(A,Get(A));');
+  '  A:=Copy(A,1);',
+  '  A:=Copy(A,2,3);',
+  '  A:=Copy(Get(A),2,3);',
+  '  Get(Copy(A));',
+  '  A:=Concat(A);',
+  '  A:=Concat(A,Get(A));',
+  '  A:=Copy( {#a_array}[1]);',
+  '  A:=Copy( {#b1_array}[1]+ {#b2_array}[2,3]);',
+  '  A:=Concat( {#c_array}[1]);',
+  '  A:=Concat( {#d1_array}[1], {#d2_array}[2,3]);',
+  '  FA:=concat([red]);',
+  '  FA:=concat([red],FA);',
+  '']);
   ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
 end;
 
 procedure TTestResolver.TestStaticArray_CopyConcat;
@@ -12204,21 +12407,22 @@ begin
   exit;
   //ResolverEngine.Options:=ResolverEngine.Options+[proStaticArrayCopy,proStaticArrayConcat];
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  integer = longint;');
+  'type',
-  Add('  TArrayInt = array of integer;');
+  '  integer = longint;',
-  Add('  TThreeInts = array[1..3] of integer;');
+  '  TArrayInt = array of integer;',
-  Add('function Get(A: TThreeInts): TThreeInts; begin end;');
+  '  TThreeInts = array[1..3] of integer;',
-  Add('var');
+  'function Get(A: TThreeInts): TThreeInts; begin end;',
-  Add('  i: integer;');
+  'var',
-  Add('  A: TArrayInt;');
+  '  i: integer;',
-  Add('  S: TThreeInts;');
+  '  A: TArrayInt;',
-  Add('begin');
+  '  S: TThreeInts;',
-  Add('  A:=Copy(S);');
+  'begin',
-  Add('  A:=Copy(S,1);');
+  '  A:=Copy(S);',
-  Add('  A:=Copy(S,2,3);');
+  '  A:=Copy(S,1);',
-  Add('  A:=Copy(Get(S),2,3);');
+  '  A:=Copy(S,2,3);',
-  Add('  A:=Concat(S,Get(S));');
+  '  A:=Copy(Get(S),2,3);',
+  '  A:=Concat(S,Get(S));']);
   ParseProgram;
 end;
 
@@ -12235,26 +12439,63 @@ begin
   Add('  B: TArrayStr;');
   Add('begin');
   Add('  A:=Copy(B);');
-  CheckResolverException('Incompatible types: got "TArrayStr" expected "TArrayInt"',
+  CheckResolverException('Incompatible types: got "array of integer" expected "array of String"',
     nIncompatibleTypesGotExpected);
 end;
 
-procedure TTestResolver.TestArray_InsertDelete;
+procedure TTestResolver.TestArray_InsertDeleteAccess;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  integer = longint;');
+  '{$modeswitch arrayoperators}',
-  Add('  TArrayInt = array of integer;');
+  'type',
-  Add('var');
+  '  integer = longint;',
-  Add('  i: integer;');
+  '  TArrayInt = array of integer;',
-  Add('  A: TArrayInt;');
+  '  TArrArrInt = array of TArrayInt;',
-  Add('begin');
+  'var',
-  Add('  Insert({#a1_read}i+1,{#a2_var}A,{#a3_read}i+2);');
+  '  i: integer;',
-  Add('  Delete({#b1_var}A,{#b2_read}i+3,{#b3_read}i+4);');
+  '  A: TArrayInt;',
+  '  A2: TArrArrInt;',
+  'begin',
+  '  Insert({#a1_read}i+1,{#a2_var}A,{#a3_read}i+2);',
+  '  Insert([i],A2,i+2);',
+  '  Insert(A+[1],A2,i+2);',
+  '  Delete({#b1_var}A,{#b2_read}i+3,{#b3_read}i+4);']);
   ParseProgram;
   CheckAccessMarkers;
 end;
 
+procedure TTestResolver.TestArray_InsertArray;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch arrayoperators}',
+  'type',
+  '  integer = longint;',
+  '  TArrayInt = array of integer;',
+  '  TArrArrInt = array of TArrayInt;',
+  '  TCol = (red,blue);',
+  '  TSetCol = set of TCol;',
+  '  TArrayCol = array of TCol;',
+  '  TArrArrCol = array of TArrayCol;',
+  '  TArrSetCol = array of TSetCol;',
+  'var',
+  '  i: integer;',
+  '  ArrInt: TArrayInt;',
+  '  ArrArrInt: TArrArrInt;',
+  '  ArrArrCol: TArrArrCol;',
+  '  ArrSetCol: TArrSetCol;',
+  'begin',
+  '  Insert( {#a_array}[1], ArrArrInt, i+2);',
+  '  Insert( {#b_array}[i], ArrArrInt, 3);',
+  '  Insert( ArrInt+ {#c_array}[1], ArrArrInt, 4);',
+  '  Insert( {#d_set}[red], ArrSetCol, 5);',
+  '  Insert( {#e_array}[red], ArrArrCol, 6);',
+  '']);
+  ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
+end;
+
 procedure TTestResolver.TestStaticArray_InsertFail;
 begin
   StartProgram(false);
@@ -12358,6 +12599,26 @@ begin
   CheckResolverException('Variable identifier expected',nVariableIdentifierExpected);
 end;
 
+procedure TTestResolver.TestArray_ForIn;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch arrayoperators}',
+  'var',
+  '  a: array of longint;',
+  '  s: array[1,2] of longint;',
+  '  i: longint;',
+  'begin',
+  '  for i in a do ;',
+  '  for i in s do ;',
+  '  for i in a+ {#a_array}[1] do ;',
+  '  for i in {#b1_set}[1]+ {#b2_set}[2] do ;',
+  '  for i in {#c_set}[1,2] do ;',
+  '']);
+  ParseProgram;
+  CheckParamsExpr_pkSet_Markers;
+end;
+
 procedure TTestResolver.TestArrayOfConst;
 begin
   StartProgram(false);
@@ -12864,28 +13125,36 @@ end;
 procedure TTestResolver.TestArrayOfProc;
 begin
   StartProgram(false);
-  Add('type');
+  Add([
-  Add('  TObject = class end;');
+  'type',
-  Add('  TNotifyProc = function(Sender: TObject = nil): longint;');
+  '  TObject = class end;',
-  Add('  TProcArray = array of TNotifyProc;');
+  '  TNotifyProc = function(Sender: TObject = nil): longint;',
-  Add('function ProcA(Sender: TObject): longint;');
+  '  TProcArray = array of TNotifyProc;',
-  Add('begin end;');
+  'function ProcA(Sender: TObject): longint;',
-  Add('var');
+  'begin end;',
-  Add('  a: TProcArray;');
+  'procedure DoIt(const a: TProcArray);',
-  Add('  p: TNotifyProc;');
+  'begin end;',
-  Add('begin');
+  'var',
-  Add('  a[0]:=@ProcA;');
+  '  a: TProcArray;',
-  Add('  if a[1]=@ProcA then ;');
+  '  p: TNotifyProc;',
-  Add('  if @ProcA=a[2] then ;');
+  'begin',
-  // Add('  a[3];'); ToDo
+  '  a[0]:=@ProcA;',
-  Add('  a[3](nil);');
+  '  if a[1]=@ProcA then ;',
-  Add('  if a[4](nil)=5 then ;');
+  '  if @ProcA=a[2] then ;',
-  Add('  if 6=a[7](nil) then ;');
+  // '  a[3];', ToDo
-  Add('  a[8]:=a[9];');
+  '  a[3](nil);',
-  Add('  p:=a[10];');
+  '  if a[4](nil)=5 then ;',
-  Add('  a[11]:=p;');
+  '  if 6=a[7](nil) then ;',
-  Add('  if a[12]=p then ;');
+  '  a[8]:=a[9];',
-  Add('  if p=a[13] then ;');
+  '  p:=a[10];',
+  '  a[11]:=p;',
+  '  if a[12]=p then ;',
+  '  if p=a[13] then ;',
+  '  DoIt([@ProcA]);',
+  '  DoIt([nil]);',
+  '  DoIt([nil,@ProcA]);',
+  '  DoIt([p]);',
+  '']);
   ParseProgram;
 end;