* Patch from Mattias Gaertner:

  pastree: fixed double iterations in foreach
  parser: fixed skipping token after var declaration without checking
  pasresolver: 
  - ord(char), chr()
  - method visibility: warn and fix if override has lower visibility
  - open arrays
  - allow descendants to add their own base types
  - typecast to alias type
  pasuseanalyzer: support public modifier

git-svn-id: trunk@35667 -

packages/fcl-passrc/src/pastree.pp

@@ -1226,6 +1226,7 @@ Type
   end;
 
   { TPasImplForLoop }
+
   TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
   public
@@ -2693,7 +2694,7 @@ begin
   if IfBranch=nil then
     begin
     IfBranch:=Element;
-    element.AddRef;
+    Element.AddRef;
     end
   else if ElseBranch=nil then
     begin
@@ -2712,10 +2713,12 @@ end;
 procedure TPasImplIfElse.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
-  ForEachChildCall(aMethodCall,Arg,IfBranch,false);
-  ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  if Elements.IndexOf(IfBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,IfBranch,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplIfElse.Condition: string;
@@ -2749,12 +2752,13 @@ end;
 procedure TPasImplForLoop.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,VariableName,false);
   ForEachChildCall(aMethodCall,Arg,Variable,false);
   ForEachChildCall(aMethodCall,Arg,StartExpr,false);
   ForEachChildCall(aMethodCall,Arg,EndExpr,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplForLoop.Down: boolean;
@@ -3931,15 +3935,16 @@ begin
     Body.AddRef;
     end
   else
-    raise Exception.Create('TPasImplWhileDo.AddElement body already set - please report this bug');
+    raise Exception.Create('TPasImplWhileDo.AddElement body already set');
 end;
 
 procedure TPasImplWhileDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplWhileDo.Condition: string;
@@ -3982,9 +3987,10 @@ end;
 procedure TPasImplCaseOf.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,CaseExpr,false);
-  ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplCaseOf.Expression: string;
@@ -4025,6 +4031,8 @@ begin
     Body:=Element;
     Body.AddRef;
     end
+  else
+    raise Exception.Create('TPasImplCaseStatement.AddElement body already set');
 end;
 
 procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
@@ -4038,10 +4046,11 @@ procedure TPasImplCaseStatement.ForEachCall(
 var
   i: Integer;
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to Expressions.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 { TPasImplWithDo }
@@ -4071,7 +4080,9 @@ begin
     begin
     Body:=Element;
     Body.AddRef;
-    end;
+    end
+  else
+    raise Exception.Create('TPasImplWithDo.AddElement body already set');
 end;
 
 procedure TPasImplWithDo.AddExpression(const Expression: TPasExpr);
@@ -4086,6 +4097,8 @@ var
 begin
   for i:=0 to Expressions.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
   inherited ForEachCall(aMethodCall, Arg);
 end;
 
@@ -4149,10 +4162,11 @@ end;
 procedure TPasImplExceptOn.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
-  inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,VarEl,false);
   ForEachChildCall(aMethodCall,Arg,TypeEl,false);
-  ForEachChildCall(aMethodCall,Arg,Body,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplExceptOn.VariableName: String;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -703,7 +703,8 @@ begin
     {$ENDIF}
     if Decl is TPasProcedure then
       begin
-      if OnlyExports and (TPasProcedure(Decl).PublicName=nil) then continue;
+      if OnlyExports and ([pmExport,pmPublic]*TPasProcedure(Decl).Modifiers=[]) then
+        continue;
       UseProcedure(TPasProcedure(Decl))
       end
     else if Decl is TPasType then

packages/fcl-passrc/src/pparser.pp

@@ -2599,6 +2599,7 @@ begin
                     Declarations.Declarations.Add(VarEl);
                     Declarations.Variables.Add(VarEl);
                   end;
+                  CheckToken(tkSemicolon);
                 finally
                   List.Free;
                 end;
@@ -3476,8 +3477,6 @@ begin
   pmPublic:
     begin
     NextToken;
-    { Should be token Name,
-      if not we're in a class and the public section starts }
     If not CurTokenIsIdentifier('name') then
       begin
       if P.Parent is TPasClassType then

packages/fcl-passrc/tests/tcresolver.pas

@@ -72,6 +72,16 @@ type
     property Module: TPasModule read FModule write SetModule;
   end;
 
+  { TTestResolverMessage }
+
+  TTestResolverMessage = class
+  public
+    Id: int64;
+    MsgType: TMessageType;
+    MsgNumber: integer;
+    Msg: string;
+  end;
+
   TTestResolverReferenceData = record
     Filename: string;
     Row: integer;
@@ -93,12 +103,16 @@ type
     FFirstStatement: TPasImplBlock;
     FModules: TObjectList;// list of TTestEnginePasResolver
     FResolverEngine: TTestEnginePasResolver;
+    FResolverMsgs: TObjectList; // list of TTestResolverMessage
     function GetModuleCount: integer;
     function GetModules(Index: integer): TTestEnginePasResolver;
+    function GetMsgCount: integer;
+    function GetMsgs(Index: integer): TTestResolverMessage;
     function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
     procedure OnFindReference(El: TPasElement; FindData: pointer);
     procedure OnCheckElementParent(El: TPasElement; arg: pointer);
     procedure FreeSrcMarkers;
+    procedure OnPasResolverLog(Sender: TObject; const Msg: String);
   Protected
     FirstSrcMarker, LastSrcMarker: PSrcMarker;
     Procedure SetUp; override;
@@ -107,6 +121,7 @@ type
     procedure ParseProgram; virtual;
     procedure ParseUnit; virtual;
     procedure CheckReferenceDirectives; virtual;
+    procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string; MustHave: boolean);
     procedure CheckResolverException(Msg: string; MsgNumber: integer);
     procedure CheckParserException(Msg: string; MsgNumber: integer);
     procedure CheckAccessMarkers; virtual;
@@ -119,6 +134,8 @@ type
     procedure RaiseErrorAtSrc(Msg: string; const aFilename: string; aRow, aCol: integer);
     procedure RaiseErrorAtSrcMarker(Msg: string; aMarker: PSrcMarker);
   Public
+    constructor Create; override;
+    destructor Destroy; override;
     function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
     function AddModule(aFilename: string): TTestEnginePasResolver;
     function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
@@ -130,6 +147,8 @@ type
     property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
     property ModuleCount: integer read GetModuleCount;
     property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
+    property MsgCount: integer read GetMsgCount;
+    property Msgs[Index: integer]: TTestResolverMessage read GetMsgs;
   end;
 
   { TTestResolver }
@@ -162,8 +181,11 @@ type
     Procedure TestStr_BaseTypes;
     Procedure TestStr_StringFail;
     Procedure TestStr_CharFail;
+    Procedure TestVarNoSemicolonBeginFail;
 
     // strings
+    Procedure TestChar_Ord;
+    Procedure TestChar_Chr;
     Procedure TestString_SetLength;
     Procedure TestString_Element;
     Procedure TestStringElement_MissingArgFail;
@@ -198,10 +220,14 @@ type
     Procedure TestFloatOperators;
     Procedure TestCAssignments;
     Procedure TestTypeCastBaseTypes;
+    Procedure TestTypeCastAliasBaseTypes;
     Procedure TestTypeCastStrToIntFail;
+    Procedure TestTypeCastStrToCharFail;
     Procedure TestTypeCastIntToStrFail;
     Procedure TestTypeCastDoubleToStrFail;
     Procedure TestTypeCastDoubleToIntFail;
+    Procedure TestTypeCastDoubleToBoolFail;
+    Procedure TestTypeCastBooleanToDoubleFail;
     Procedure TestHighLow;
     Procedure TestAssign_Access;
 
@@ -344,6 +370,7 @@ type
     Procedure TestClass_Sealed;
     Procedure TestClass_SealedDescendFail;
     Procedure TestClass_VarExternal;
+    Procedure TestClass_WarnOverrideLowerVisibility;
     // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
 
     // external class
@@ -428,6 +455,8 @@ type
     Procedure TestArray_AssignNilToStaticArrayFail1;
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_PassArrayElementToVarParam;
+    Procedure TestArray_OpenArrayOfString;
+    Procedure TestArray_OpenArrayOfString_IntFail;
 
     // procedure types
     Procedure TestProcTypesAssignObjFPC;
@@ -520,6 +549,7 @@ end;
 
 procedure TCustomTestResolver.TearDown;
 begin
+  FResolverMsgs.Clear;
   {$IFDEF VerbosePasResolverMem}
   writeln('TTestResolver.TearDown START FreeSrcMarkers');
   {$ENDIF}
@@ -998,6 +1028,42 @@ begin
   //writeln('TTestResolver.CheckReferenceDirectives COMPLETE');
 end;
 
+procedure TCustomTestResolver.CheckResolverHint(MsgType: TMessageType;
+  MsgNumber: integer; Msg: string; MustHave: boolean);
+var
+  i: Integer;
+  Item: TTestResolverMessage;
+  Expected,Actual: string;
+begin
+  writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount);
+  for i:=0 to MsgCount-1 do
+    begin
+    Item:=Msgs[i];
+    if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
+    // found
+    str(Item.MsgType,Actual);
+    if not MustHave then
+      begin
+      WriteSources('',0,0);
+      Fail('Expected to *not* emit '+Actual+' ('+IntToStr(MsgNumber)+') {'+Msg+'}');
+      end;
+    str(MsgType,Expected);
+    AssertEquals('MsgType',Expected,Actual);
+    exit;
+    end;
+  if not MustHave then exit;
+
+  // needed message missing -> show emitted messages
+  WriteSources('',0,0);
+  for i:=0 to MsgCount-1 do
+    begin
+    Item:=Msgs[i];
+    writeln('TCustomTestResolver.CheckResolverHint ',Item.MsgType,' ('+IntToStr(Item.MsgNumber),') {',Item.Msg,'}');
+    end;
+  str(MsgType,Expected);
+  Fail('Missing '+Expected+' ('+IntToStr(MsgNumber)+') '+Msg);
+end;
+
 procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer);
 var
   ok: Boolean;
@@ -1217,6 +1283,18 @@ begin
   RaiseErrorAtSrc(Msg,aMarker^.Filename,aMarker^.Row,aMarker^.StartCol);
 end;
 
+constructor TCustomTestResolver.Create;
+begin
+  inherited Create;
+  FResolverMsgs:=TObjectList.Create(true);
+end;
+
+destructor TCustomTestResolver.Destroy;
+begin
+  FreeAndNil(FResolverMsgs);
+  inherited Destroy;
+end;
+
 function TCustomTestResolver.FindModuleWithFilename(aFilename: string
   ): TTestEnginePasResolver;
 var
@@ -1237,6 +1315,7 @@ begin
   Result.Filename:=aFilename;
   Result.AddObjFPCBuiltInIdentifiers;
   Result.OnFindUnit:=@OnPasResolverFindUnit;
+  Result.OnLog:=@OnPasResolverLog;
   FModules.Add(Result);
 end;
 
@@ -1535,11 +1614,39 @@ begin
     end;
 end;
 
+procedure TCustomTestResolver.OnPasResolverLog(Sender: TObject;
+  const Msg: String);
+var
+  aResolver: TTestEnginePasResolver;
+  Item: TTestResolverMessage;
+begin
+  aResolver:=Sender as TTestEnginePasResolver;
+  Item:=TTestResolverMessage.Create;
+  Item.Id:=aResolver.LastMsgId;
+  Item.MsgType:=aResolver.LastMsgType;
+  Item.MsgNumber:=aResolver.LastMsgNumber;
+  Item.Msg:=Msg;
+  {$IFDEF VerbosePasResolver}
+  writeln('TCustomTestResolver.OnPasResolverLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
+  {$ENDIF}
+  FResolverMsgs.Add(Item);
+end;
+
 function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
 end;
 
+function TCustomTestResolver.GetMsgCount: integer;
+begin
+  Result:=FResolverMsgs.Count;
+end;
+
+function TCustomTestResolver.GetMsgs(Index: integer): TTestResolverMessage;
+begin
+  Result:=TTestResolverMessage(FResolverMsgs[Index]);
+end;
+
 function TCustomTestResolver.GetModuleCount: integer;
 begin
   Result:=FModules.Count;
@@ -1834,6 +1941,7 @@ begin
   Add('  s: single;');
   Add('  d: double;');
   Add('  aString: string;');
+  Add('  r: record end;');
   Add('begin');
   Add('  Str(b,{#a_var}aString);');
   Add('  Str(b:1,aString);');
@@ -1853,6 +1961,17 @@ begin
   Add('  aString:=Str(i:3);');
   Add('  aString:=Str(d:3:4);');
   Add('  aString:=Str(b,i,d);');
+  Add('  aString:=Str(s,''foo'');');
+  Add('  aString:=Str(i,{#assign_read}aString);');
+  Add('  while true do Str(i,{#whiledo_var}aString);');
+  Add('  repeat Str(i,{#repeat_var}aString); until true;');
+  Add('  if true then Str(i,{#ifthen_var}aString) else Str(i,{#ifelse_var}aString);');
+  Add('  for i:=0 to 0 do Str(i,{#fordo_var}aString);');
+  Add('  with r do Str(i,{#withdo_var}aString);');
+  Add('  case Str(s,''caseexpr'') of');
+  Add('  ''bar'': Str(i,{#casest_var}aString);');
+  Add('  else Str(i,{#caseelse_var}aString);');
+  Add('  end;');
   ParseProgram;
   CheckAccessMarkers;
 end;
@@ -1880,6 +1999,40 @@ begin
     nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestVarNoSemicolonBeginFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; begin end;');
+  Add('var');
+  Add('  i: longint');
+  Add('begin');
+  Add('  doit;');
+  CheckParserException('Expected ";" at token "begin" in file afile.pp at line 5 column 5',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestChar_Ord;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=ord(c);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestChar_Chr;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  c:=chr(i);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestString_SetLength;
 begin
   StartProgram(false);
@@ -2553,6 +2706,8 @@ begin
   Add('  fs: single;');
   Add('  d: double;');
   Add('  b: boolean;');
+  Add('  c: char;');
+  Add('  s: char;');
   Add('begin');
   Add('  d:=double({#a_read}i);');
   Add('  i:=shortint({#b_read}i);');
@@ -2564,6 +2719,39 @@ begin
   Add('  b:=bytebool({#i_read}longbool({#h_read}b));');
   Add('  d:=double({#j_read}i)/2.5;');
   Add('  b:=boolean({#k_read}i);');
+  Add('  i:=longint({#l_read}b);');
+  Add('  d:=double({#m_read}i);');
+  Add('  c:=char({#n_read}c);');
+  Add('  s:=string({#o_read}s);');
+  Add('  s:=string({#p_read}c);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestTypeCastAliasBaseTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TCaption = string;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TChar = char;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  i:=integer({#a_read}i);');
+  Add('  i:=integer({#h_read}b);');
+  Add('  s:=TCaption({#b_read}s);');
+  Add('  s:=TCaption({#g_read}c);');
+  Add('  b:=TYesNo({#c_read}b);');
+  Add('  b:=TYesNo({#d_read}i);');
+  Add('  d:=TFloat({#e_read}d);');
+  Add('  c:=TChar({#f_read}c);');
   ParseProgram;
   CheckAccessMarkers;
 end;
@@ -2579,6 +2767,17 @@ begin
   CheckResolverException('illegal type conversion: string to longint',PasResolver.nIllegalTypeConversionTo);
 end;
 
+procedure TTestResolver.TestTypeCastStrToCharFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  c:=char(s);');
+  CheckResolverException('illegal type conversion: string to char',PasResolver.nIllegalTypeConversionTo);
+end;
+
 procedure TTestResolver.TestTypeCastIntToStrFail;
 begin
   StartProgram(false);
@@ -2612,6 +2811,28 @@ begin
   CheckResolverException('illegal type conversion: double to longint',PasResolver.nIllegalTypeConversionTo);
 end;
 
+procedure TTestResolver.TestTypeCastDoubleToBoolFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  b:=longint(d);');
+  CheckResolverException('illegal type conversion: double to boolean',PasResolver.nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastBooleanToDoubleFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  d:=double(b);');
+  CheckResolverException('illegal type conversion: boolean to double',PasResolver.nIllegalTypeConversionTo);
+end;
+
 procedure TTestResolver.TestHighLow;
 begin
   StartProgram(false);
@@ -5367,6 +5588,44 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_WarnOverrideLowerVisibility;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict protected');
+  Add('    procedure DoStrictProtected; virtual; abstract;');
+  Add('  protected');
+  Add('    procedure DoProtected; virtual; abstract;');
+  Add('  public');
+  Add('    procedure DoPublic; virtual; abstract;');
+  Add('  published');
+  Add('    procedure DoPublished; virtual; abstract;');
+  Add('  end;');
+  Add('  TBird = class(TObject)');
+  Add('  private');
+  Add('    procedure DoStrictProtected; override;');
+  Add('    procedure DoProtected; override;');
+  Add('  protected');
+  Add('    procedure DoPublic; override;');
+  Add('    procedure DoPublished; override;');
+  Add('  end;');
+  Add('procedure TBird.DoStrictProtected; begin end;');
+  Add('procedure TBird.DoProtected; begin end;');
+  Add('procedure TBird.DoPublic; begin end;');
+  Add('procedure TBird.DoPublished; begin end;');
+  Add('begin');
+  ParseProgram;
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)',true);
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)',true);
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)',true);
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)',true);
+end;
+
 procedure TTestResolver.TestExternalClass;
 begin
   StartProgram(false);
@@ -6814,6 +7073,34 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestArray_OpenArrayOfString;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(const a: array of String);');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
+  Add('end;');
+  Add('var s: string;');
+  Add('begin');
+  Add('  DoIt([]);');
+  Add('  DoIt([s,''foo'','''',s+s]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_OpenArrayOfString_IntFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(const a: array of String);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt([1]);');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestProcTypesAssignObjFPC;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -97,6 +97,7 @@ type
     procedure TestWP_UnitInitialization;
     procedure TestWP_UnitFinalization;
     procedure TestWP_CallInherited;
+    procedure TestWP_ProgramPublicDeclarations;
   end;
 
 implementation
@@ -1232,6 +1233,18 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#vPublic_used}vPublic: longint; public;');
+  Add('  {#vPrivate_notused}vPrivate: longint;');
+  Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
+  Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
+  Add('begin');
+  AnalyzeWholeProgram;
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);