From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,447840d42a580dc0 X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2002-04-23 14:44:49 PST Path: archiver1.google.com!postnews1.google.com!not-for-mail From: okellogg@freenet.de (Oliver Kellogg) Newsgroups: comp.lang.ada Subject: Re: child packages and nested packages Date: 23 Apr 2002 14:44:49 -0700 Organization: http://groups.google.com/ Message-ID: <6a6390b8.0204231344.6fd957ca@posting.google.com> References: <6a6390b8.0203230702.14c071c1@posting.google.com> <4519e058.0203250701.7819a546@posting.google.com> <6a6390b8.0203251126.8eebc37@posting.google.com> NNTP-Posting-Host: 62.246.12.193 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit X-Trace: posting.google.com 1019598289 6117 127.0.0.1 (23 Apr 2002 21:44:49 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: 23 Apr 2002 21:44:49 GMT Xref: archiver1.google.com comp.lang.ada:23017 Date: 2002-04-23T21:44:49+00:00 List-Id: 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;