fcl-passrc: resolver: fixed dotted runit reference

git-svn-id: trunk@36117 -

packages/fcl-passrc/src/pasresolver.pp

@@ -618,6 +618,7 @@ type
 
   TPasModuleScope = class(TPasScope)
   public
+    FirstName: string;
     procedure IterateElements(const aName: string; StartScope: TPasScope;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
       var Abort: boolean); override;
@@ -1528,6 +1529,7 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
 
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 function ChompDottedIdentifier(const Identifier: string): string;
+function FirstDottedIdentifier(const Identifier: string): string;
 function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
 
 function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
@@ -1815,6 +1817,17 @@ begin
   Result:=LeftStr(Identifier,p-1);
 end;
 
+function FirstDottedIdentifier(const Identifier: string): string;
+var
+  p: SizeInt;
+begin
+  p:=Pos('.',Identifier);
+  if p<1 then
+    Result:=Identifier
+  else
+    Result:=LeftStr(Identifier,p-1);
+end;
+
 function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
 var
   l: Integer;
@@ -2287,7 +2300,7 @@ procedure TPasModuleScope.IterateElements(const aName: string;
   StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
   Data: Pointer; var Abort: boolean);
 begin
-  if CompareText(aName,Element.Name)<>0 then exit;
+  if CompareText(aName,FirstName)<>0 then exit;
   OnIterateElement(Element,Self,StartScope,Data,Abort);
 end;
 
@@ -4985,6 +4998,7 @@ var
   BuiltInProc: TResElDataBuiltInProc;
   p: SizeInt;
   DottedName: String;
+  Bin: TBinaryExpr;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
@@ -5041,14 +5055,18 @@ begin
       if El=nil then
         RaiseInternalError(20170503002012);
       CreateReference(DeclEl,El,Access);
+      if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
+        begin
+        Bin:=TBinaryExpr(El.Parent);
+        while Bin.OpCode=eopSubIdent do
+          begin
+          CreateReference(DeclEl,Bin,Access);
+          if not (Bin.Parent is TBinaryExpr) then break;
+          if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
+          Bin:=TBinaryExpr(Bin.Parent);
+          end;
+        end;
     until false;
-    // and add references to the binary expressions
-    while (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) do
-      begin
-      El:=TBinaryExpr(El.Parent);
-      if TBinaryExpr(El).OpCode<>eopSubIdent then break;
-      CreateReference(DeclEl,El,Access);
-      end;
     end;
 end;
 
@@ -5847,11 +5865,13 @@ end;
 procedure TPasResolver.AddModule(El: TPasModule);
 var
   C: TClass;
+  ModScope: TPasModuleScope;
 begin
   if TopScope<>DefaultScope then
     RaiseInvalidScopeForElement(20160922163504,El);
-  PushScope(El,TPasModuleScope);
-  TPasModuleScope(TopScope).VisibilityContext:=El;
+  ModScope:=TPasModuleScope(PushScope(El,TPasModuleScope));
+  ModScope.VisibilityContext:=El;
+  ModScope.FirstName:=FirstDottedIdentifier(El.Name);
   C:=El.ClassType;
   if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
     FDefaultNameSpace:=ChompDottedIdentifier(El.Name)

packages/fcl-passrc/tests/tcresolver.pas

@@ -280,6 +280,9 @@ type
     Procedure TestUnitUseDotted;
     Procedure TestUnit_ProgramDefaultNamespace;
     Procedure TestUnit_DottedIdentifier;
+    Procedure TestUnit_DottedPrg;
+    Procedure TestUnit_DottedUnit;
+    Procedure TestUnit_DottedExpr;
     Procedure TestUnit_DuplicateDottedUsesFail;
     Procedure TestUnit_DuplicateUsesDiffNameFail;
     Procedure TestUnit_Unit1DotUnit2Fail;
@@ -1260,14 +1263,14 @@ begin
           Ref:=TResolvedReference(El.CustomData);
           if ActualAccess<>rraNone then
             begin
-            writeln('TTestResolver.CheckAccessMarkers multiple references at "#'+aMarker^.Identifier+'":');
+            //writeln('TTestResolver.CheckAccessMarkers multiple references at "#'+aMarker^.Identifier+'":');
             for j:=0 to Elements.Count-1 do
               begin
               El2:=TPasElement(Elements[i]);
               if not (El2.CustomData is TResolvedReference) then continue;
               //writeln('TTestResolver.CheckAccessMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
               Ref:=TResolvedReference(El.CustomData);
-              writeln('  ',j,'/',Elements.Count,' Element=',GetObjName(El2),' ',AccessNames[Ref.Access],' Declaration="',El2.GetDeclaration(true),'"');
+              //writeln('  ',j,'/',Elements.Count,' Element=',GetObjName(El2),' ',AccessNames[Ref.Access],' Declaration="',El2.GetDeclaration(true),'"');
               end;
             RaiseErrorAtSrcMarker('multiple references at "#'+aMarker^.Identifier+'"',aMarker);
             end;
@@ -3795,13 +3798,13 @@ begin
   'begin',
   '  if j1=0 then ;',
   '']);
-  writeln('TTestResolver.TestUnit_ProgramDefaultNamespace ');
   ParseProgram;
 end;
 
 procedure TTestResolver.TestUnit_DottedIdentifier;
 begin
   MainFilename:='unitdots.main1.pas';
+
   AddModuleWithIntfImplSrc('unitdots.unit1.pp',
     LinesToStr([
     'type TColor = longint;',
@@ -3829,7 +3832,74 @@ begin
   '  if unitdots.j1=0 then ;',
   '  if unitdots.unit1.i1=0 then ;',
   '']);
-  writeln('TTestResolver.TestUnit_DottedIdentifier ');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DottedPrg;
+begin
+  MainFilename:='unitdots.main1.pas';
+
+  AddModuleWithIntfImplSrc('unitdots.unit1.pp',
+    LinesToStr([
+    'type TColor = longint;',
+    'var i1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses UnIt1;',
+  'type',
+  '  TPrgColor = UNIT1.tcolor;',
+  '  TStrange = UnitDots.Main1.tprgcolor;',
+  'var k1: longint;',
+  'begin',
+  '  if unitdots.main1.k1=0 then ;',
+  '  if unit1.i1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DottedUnit;
+begin
+  MainFilename:='unitdots.unit1.pas';
+  StartUnit(false);
+  Add([
+  'interface',
+  'var k1: longint;',
+  'implementation',
+  'initialization',
+  '  if unitDots.Unit1.k1=0 then ;',
+  '']);
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestUnit_DottedExpr;
+begin
+  MainFilename:='unitdots1.sub1.main1.pas';
+
+  AddModuleWithIntfImplSrc('unitdots2.sub2.unit2.pp',
+    LinesToStr([
+    'procedure DoIt; external name ''$DoIt'';']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unitdots3.sub3.unit3.pp',
+    LinesToStr([
+    'procedure DoSome;']),
+    LinesToStr([
+    'uses unitdots2.sub2.unit2;',
+    'procedure DoSome;',
+    'begin',
+    '  unitdots2.sub2.unit2.doit;',
+    'end;']));
+
+  StartProgram(true);
+  Add([
+  'uses unitdots3.sub3.unit3;',
+  'begin',
+  '  unitdots3.sub3.unit3.dosome;',
+  '']);
   ParseProgram;
 end;
 
@@ -4648,16 +4718,16 @@ begin
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
     begin
-    writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
     Elements:=FindElementsAt(aMarker);
     try
       for i:=0 to Elements.Count-1 do
         begin
         El:=TPasElement(Elements[i]);
-        writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',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.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration));
+        //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration));
         if not (Ref.Declaration is TPasResultElement) then continue;
         ResultEl:=TPasResultElement(Ref.Declaration);
         Proc:=ResultEl.Parent as TPasProcedure;
@@ -6203,17 +6273,17 @@ begin
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
     begin
-    writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
     Elements:=FindElementsAt(aMarker);
     try
       for i:=0 to Elements.Count-1 do
         begin
         El:=TPasElement(Elements[i]);
-        writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
         if not (El.CustomData is TResolvedReference) then continue;
         Ref:=TResolvedReference(El.CustomData);
         if not (Ref.Declaration is TPasProcedure) then continue;
-        writeln('TTestResolver.TestClass_ConDestructor_Inherited ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
         if rrfNewInstance in Ref.Flags then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
         if rrfFreeInstance in Ref.Flags then