Re: child packages and nested packages

[okellogg@freenet.de (Oliver Kellogg)]

I'm attempting to implement this feature (permitting a nested
package as the parent the of a child package) in GNAT.
Since it's just a proof of concept, I'm doing this only for the
simple case where the parent is nested exactly one deep.
However, I'm having a problem. It seems to relate to

  Names : List_Id := New_List (Defining_Unit_Name (Specification (Decl)));

in the bottom page of the added code block below.
Later, while Analyze_Use_Package loops through the Names, the Nkind
of the (first and only) name node appears not to have been set.
I'm sure there's something wrong with the way I synthesize the use
clause.  Help, anyone?


*** par-load.adb.orig   Thu Mar 14 10:59:36 2002
--- par-load.adb        Tue Apr 23 22:25:25 2002
***************
*** 290,301 ****
           Unum :=
             Load_Unit
               (Load_Name  => Spec_Name,
!               Required   => True,
                Subunit    => False,
                Error_Node => Curunit);
  
           if Unum /= No_Unit then
              Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
           end if;
        end if;
  
--- 290,383 ----
           Unum :=
             Load_Unit
               (Load_Name  => Spec_Name,
!               Required   => False,
                Subunit    => False,
                Error_Node => Curunit);
  
           if Unum /= No_Unit then
              Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
+          else
+             --  The Spec_Name may refer to a nested package.
+             Spec_Name := Get_Parent_Spec_Name (Spec_Name);
+             if Spec_Name /= No_Name then
+                Unum :=
+                  Load_Unit
+                    (Load_Name  => Spec_Name,
+                     Required   => True,
+                     Subunit    => False,
+                     Error_Node => Curunit);
+                if Unum /= No_Unit then
+                   Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
+                   --  Check that the referenced nested package exists.
+                   declare
+                      function Infix (Threefix : String) return String;
+                      --  Given a name "A.B.C", returns "B".
+                      --  Returns "" if the input name does not contain
+                      --  two periods.
+                      function Infix (Threefix : String) return String is
+                         I1 : Natural := Threefix'First;
+                         I2 : Natural;
+                      begin
+                         while I1 <= Threefix'Last
+                           and then Threefix (I1) /= '.' loop
+                            I1 := I1 + 1;
+                         end loop;
+                         if I1 = Threefix'Last then
+                            return "";
+                         end if;
+                         I1 := I1 + 1;
+                         I2 := I1;
+                         while I2 <= Threefix'Last
+                           and then Threefix (I2) /= '.' loop
+                            I2 := I2 + 1;
+                         end loop;
+                         if I2 = Threefix'Last then
+                            return "";
+                         end if;
+                         return Threefix (I1 .. I2 - 1);
+                      end Infix;
+                      Found : Boolean := False;
+                      Spec : Node_Id := Specification (Unit (Cunit (Unum)));
+                      Decls : List_Id := Visible_Declarations (Spec);
+                      Decl : Node_Id := First (Decls);
+                      Nested_Name : String
+                        := Infix (Get_Name_String (Unit_Name (Cur_Unum)));
+                      Pkg_Name : Name_Id;
+                   begin
+                      while Present (Decl) loop
+                         if Nkind (Decl) = N_Package_Declaration then
+                            Pkg_Name :=
+                              Chars (Defining_Unit_Name (Specification (Decl)))
;
+                            if Get_Name_String (Pkg_Name) = Nested_Name then
+                               Found := True;
+                               exit;
+                            end if;
+                         end if;
+                         Next (Decl);
+                      end loop;
+                      if Found then
+                         Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
+                         --  Synthesize a use clause for the parent package.
+                         declare
+                            Names : List_Id
+                              := New_List
+                                (Defining_Unit_Name (Specification (Decl)));
+                            Use_Nested_Parent : Node_Id
+                              := Make_Use_Package_Clause (Loc, Names);
+                         begin
+                            Prepend_To
+                              (Visible_Declarations
+                                 (Specification (Unit (Curunit))),
+                                  Use_Nested_Parent);
+                            Mark_Rewrite_Insertion (Use_Nested_Parent);
+                         end;
+                      else
+                         Error_Msg ("parent package not found", Loc);
+                      end if;
+                   end;
+ 
+                end if;
+             end if;
           end if;
        end if;