Browse Source

fcl-passrc: resolver: fixed regression uses clause order

git-svn-id: trunk@37789 -
Mattias Gaertner 7 years ago
parent
commit
bd7da20bdd
2 changed files with 31 additions and 5 deletions
  1. 3 3
      packages/fcl-passrc/src/pasresolver.pp
  2. 28 2
      packages/fcl-passrc/tests/tcresolver.pas

+ 3 - 3
packages/fcl-passrc/src/pasresolver.pp

@@ -2322,7 +2322,7 @@ begin
   Result:=inherited FindIdentifier(Identifier);
   Result:=inherited FindIdentifier(Identifier);
   if Result<>nil then
   if Result<>nil then
     exit;
     exit;
-  for i:=0 to UsesScopes.Count-1 do
+  for i:=UsesScopes.Count-1 downto 0 do
     begin
     begin
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     {$IFDEF VerbosePasResolver}
     {$IFDEF VerbosePasResolver}
@@ -2350,7 +2350,7 @@ begin
   if Abort then exit;
   if Abort then exit;
   FilterData.OnIterate:=OnIterateElement;
   FilterData.OnIterate:=OnIterateElement;
   FilterData.Data:=Data;
   FilterData.Data:=Data;
-  for i:=0 to UsesScopes.Count-1 do
+  for i:=UsesScopes.Count-1 downto 0 do
     begin
     begin
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     {$IFDEF VerbosePasResolver}
     {$IFDEF VerbosePasResolver}
@@ -2369,7 +2369,7 @@ var
 begin
 begin
   inherited WriteIdentifiers(Prefix);
   inherited WriteIdentifiers(Prefix);
   SubPrefix:=Prefix+'    ';
   SubPrefix:=Prefix+'    ';
-  for i:=0 to UsesScopes.Count-1 do
+  for i:=UsesScopes.Count-1 downto 0 do
     begin
     begin
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     UsesScope:=TPasIdentifierScope(UsesScopes[i]);
     writeln(Prefix+'  Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
     writeln(Prefix+'  Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');

+ 28 - 2
packages/fcl-passrc/tests/tcresolver.pas

@@ -354,6 +354,7 @@ type
     Procedure TestProcOverloadWithInhAliasClassTypes;
     Procedure TestProcOverloadWithInhAliasClassTypes;
     Procedure TestProcOverloadBaseTypeOtherUnit;
     Procedure TestProcOverloadBaseTypeOtherUnit;
     Procedure TestProcOverloadBaseProcNoHint;
     Procedure TestProcOverloadBaseProcNoHint;
+    Procedure TestProcOverload_UnitOrderFail;
     Procedure TestProcOverloadDelphiMissingNextOverload;
     Procedure TestProcOverloadDelphiMissingNextOverload;
     Procedure TestProcOverloadDelphiMissingPrevOverload;
     Procedure TestProcOverloadDelphiMissingPrevOverload;
     Procedure TestProcOverloadDelphiUnit;
     Procedure TestProcOverloadDelphiUnit;
@@ -5160,7 +5161,6 @@ begin
   AddModuleWithIntfImplSrc('unit2.pp',
   AddModuleWithIntfImplSrc('unit2.pp',
     LinesToStr([
     LinesToStr([
     'procedure Val(var d: double);',
     'procedure Val(var d: double);',
-    //'procedure Val(var i: integer);',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
     'procedure Val(var d: double); begin end;',
     'procedure Val(var d: double); begin end;',
@@ -5173,7 +5173,6 @@ begin
   Add('  d: double;');
   Add('  d: double;');
   Add('  i: integer;');
   Add('  i: integer;');
   Add('begin');
   Add('begin');
-  //Add('  Val(i);');
   Add('  Val(d);');
   Add('  Val(d);');
   ParseProgram;
   ParseProgram;
 end;
 end;
@@ -5194,6 +5193,33 @@ begin
   CheckResolverUnexpectedHints;
   CheckResolverUnexpectedHints;
 end;
 end;
 
 
+procedure TTestResolver.TestProcOverload_UnitOrderFail;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'procedure Val(d: string);',
+    '']),
+    LinesToStr([
+    'procedure Val(d: string); begin end;',
+    '']));
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'procedure Val(d: double);',
+    '']),
+    LinesToStr([
+    'procedure Val(d: double); begin end;',
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unit1, unit2;',
+  'var',
+  '  s: string;',
+  'begin',
+  '  Val(s);']);
+  CheckResolverException(sIncompatibleTypeArgNo,nIncompatibleTypeArgNo);
+end;
+
 procedure TTestResolver.TestProcOverloadDelphiMissingNextOverload;
 procedure TTestResolver.TestProcOverloadDelphiMissingNextOverload;
 begin
 begin
   StartProgram(false);
   StartProgram(false);