[Ada] Some corner-case fixes related to generics

[Arnaud Charlet]

Tested on x86-linux, committed on mainline.

If the front-end uses the same node as the defining identifier for both a
formal package and the corresponding expanded package, this makes a problem
for ASIS when it tries to compute the enclosing element for an element
based on this defining identifier node. By adding a separate copy of
a defining identifier node for a formal package, we do not change anything
in the semantic processing but simplify the tree structure for ASIS.

In addition, when a child generic is instantiated, the instantiation takes
place in the context of an instance of each ancestor. These ancestor instances
are placed on the scope stack before the current instantiation is analyzed
and removed afterwards. If the instantiation takes place within an
instance of some other generic from the same family tree, ancestors are
already on the scope stack, and their private declarations may be
accessible.  Their status must be preserved on exit, so that the
instantiation of the sibling can proceed correctly.

Test case:
$ gcc -c essai_tri_fusion.adb  # should compile successfully
--
with List_Gen.Tri_Fusion;
procedure Essai_Tri_Fusion is
    package Liste_Int is new List_Gen (Integer);
    procedure Trier is new Liste_Int.Tri_Fusion ("<=");
begin null; end;

procedure List_Gen.Fusionner
  (Gauche, Droite : in out A_Boite ; Dans : out A_Boite) is
begin null; end;

private
generic
    with function "<=" (Gauche, Droite : Element) return Boolean;
procedure List_Gen.Fusionner
   (Gauche, Droite : in out A_Boite ; Dans : out A_Boite);

with List_Gen.Fusionner;
procedure List_Gen.Tri_Fusion (L : in out Liste) is
    procedure Fusionner is new List_Gen.Fusionner ("<=" => "<=") ;
    Reste : A_Boite := L.Tete;
begin
    L := (Tete => Reste);
end;

generic
    with function "<=" (Gauche, Droite : Element) return Boolean;
procedure List_Gen.Tri_Fusion (L : in out Liste);

generic
    type Element is private;
package List_Gen is
    type Liste is limited private;
private
    type Boite;
    type A_Boite is access Boite;
    type Liste is record Tete : A_Boite; end record;
    type Boite is record null; end record;
end List_Gen;

2005-01-03  Ed Schonberg  <schonberg@adacore.com>
	    Sergey Rybin  <rybin@adacore.com>

	* sem_ch12.adb (Analyze_Package_Instantiation): Create a separate node
	to use as the defining identifier for a formal package.
	(Remove_Parent): If the instance takes place within (an instance of)
	a sibling, preserve private declarations of common parent.

-------------- next part --------------
Index: sem_ch12.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch12.adb,v
retrieving revision 1.45
diff -u -p -r1.45 sem_ch12.adb
--- sem_ch12.adb	27 Oct 2004 13:40:55 -0000	1.45
+++ sem_ch12.adb	3 Jan 2005 15:15:33 -0000
@@ -2849,6 +2849,17 @@ package body Sem_Ch12 is
          Inline_Instance_Body (N, Gen_Unit, Act_Decl);
       end if;
 
+      --  The following is a tree patch for ASIS: ASIS needs separate nodes
+      --  to be used as defining identifiers for a formal package and for the
+      --  corresponding expanded package
+
+      if Nkind (N) = N_Formal_Package_Declaration then
+         Act_Decl_Id := New_Copy (Defining_Entity (N));
+         Set_Comes_From_Source (Act_Decl_Id, True);
+         Set_Is_Generic_Instance (Act_Decl_Id, False);
+         Set_Defining_Identifier (N, Act_Decl_Id);
+      end if;
+
    exception
       when Instantiation_Error =>
          if Parent_Installed then
@@ -8904,9 +8915,11 @@ package body Sem_Ch12 is
                  and then P /= Current_Scope
                then
                   --  We are within an instance of some sibling. Retain
-                  --  visibility of parent, for proper subsequent cleanup.
+                  --  visibility of parent, for proper subsequent cleanup,
+                  --  and reinstall private declarations as well.
 
                   Set_In_Private_Part (P);
+                  Install_Private_Declarations (P);
                end if;
 
             --  This looks incomplete: what about compilation units that