2004-07-20 Olivier Hainque <hainque@act-europe.fr>

	* a-elchha.adb (Last_Chance_Handler): Remove the bogus buffer dynamic
	allocation and potentially overflowing update with
	Tailored_Exception_Information. Use the sec-stack free procedural
	interface to output Exception_Information instead.

	* a-except.adb (To_Stderr): New subprogram for character, and string
	version moved from a-exextr to be visible from other separate units.
	(Tailored_Exception_Information): Remove the procedural version,
	previously used by the default Last_Chance_Handler and not any more.
	Adjust various comments.

	* a-exexda.adb: Generalize the exception information procedural
	interface, to minimize the use of secondary stack and the need for
	local buffers when the info is to be output to stderr:
	(Address_Image): Removed.
	(Append_Info_Character): New subprogram, checking for overflows and
	outputing to stderr if buffer to fill is of length 0.
	(Append_Info_String): Output to stderr if buffer to fill is of length 0.
	(Append_Info_Address, Append_Info_Exception_Name,
	Append_Info_Exception_Message, Append_Info_Basic_Exception_Information,
	Append_Info_Basic_Exception_Traceback,
	Append_Info_Exception_Information): New subprograms.
	(Append_Info_Nat, Append_Info_NL): Use Append_Info_Character.
	(Basic_Exception_Info_Maxlength, Basic_Exception_Tback_Maxlength,
	Exception_Info_Maxlength, Exception_Name_Length,
	Exception_Message_Length): New subprograms.
	(Exception_Information): Use Append_Info_Exception_Information.
	(Tailored_Exception_Information): Use
	Append_Info_Basic_Exception_Information.
	Export services for the default Last_Chance_Handler.

	* a-exextr.adb (To_Stderr): Remove. Now in a-except to be usable by
	other separate units.

2004-07-20  Vincent Celier  <celier@gnat.com>

	* clean.adb, mlib-utl.adb, osint.adb, makegpr.adb: Minor reformatting.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	* freeze.adb (Freeze_Entity): If entity is a discriminated record type,
	emit itype references for the designated types of component types that
	are declared outside of the full record declaration, and that may
	denote a partial view of that record type.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15607
	* sem_ch3.adb (Build_Discriminated_Subtype): Do not attach a subtype
	which is the designated type in an access component declaration, to the
	list of incomplete dependents of the parent type, to avoid elaboration
	issues with out-of-scope subtypes.
	(Complete_Private_Subtype): Recompute Has_Unknown_Discriminants from the
	full view of the parent.

2004-07-20  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15610
	* sem_ch8.adb (Find_Expanded_Name): If name is overloaded, reject
	entities that are hidden, such as references to generic actuals
	outside an instance.

2004-07-20  Javier Miranda  <miranda@gnat.com>

	* sem_ch4.adb (Try_Object_Operation): New subprogram that gives
	support to the new notation.
	(Analyze_Selected_Component): Add call to Try_Object_Operation.

2004-07-20  Jose Ruiz  <ruiz@act-europe.fr>

	* s-taprob.adb: Adding the elaboration code required for initializing
	the tasking soft links that are common to the full and the restricted
	run times.

	* s-tarest.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* s-tasini.adb (Init_RTS): Tasking soft links that are shared with the
	restricted run time has been moved to the package
	System.Soft_Links.Tasking.

	* Makefile.rtl: Add entry for s-solita.o in run-time library list.

	* s-solita.ads, s-solita.adb: New files.

2004-07-20  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (Identifier_to_gnu, Pragma_to_gnu, Attribute_to_gnu,
	Case_Statement_to_gnu): Split off from gnat_to_gnu.
	(Loop_Statement_to_gnu, Subprogram_Body_to_gnu, call_to_gnu,
	Handled_Sequence_Of_Statements_to_gnu, Exception_Handler_to_gnu_sjlj,
	Exception_Handler_to_gnu_zcx): Likewise.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@84948 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 318 insertions, 0 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index f674ba6e005..3831b6735da 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -28,6 +28,7 @@ with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
+with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
@@ -233,6 +234,9 @@ package body Sem_Ch4 is
    --  to a subprogram, and the call F (X)  interpreted as F.all (X). In
    --  this case the call may be overloaded with both interpretations.
 
+   function Try_Object_Operation (N : Node_Id) return Boolean;
+   --  Ada 2005 (AI-252): Give support to the object operation notation
+
    ------------------------
    -- Ambiguous_Operands --
    ------------------------
@@ -2677,6 +2681,15 @@ package body Sem_Ch4 is
             Next_Entity (Comp);
          end loop;
 
+         --  Ada 2005 (AI-252)
+
+         if Ada_Version >= Ada_05
+           and then Is_Tagged_Type (Prefix_Type)
+           and then Try_Object_Operation (N)
+         then
+            return;
+         end if;
+
       elsif Is_Private_Type (Prefix_Type) then
 
          --  Allow access only to discriminants of the type. If the
@@ -4635,4 +4648,309 @@ package body Sem_Ch4 is
 
    end Try_Indexed_Call;
 
+   --------------------------
+   -- Try_Object_Operation --
+   --------------------------
+
+   function Try_Object_Operation (N : Node_Id) return Boolean is
+      Obj        : constant Node_Id := Prefix (N);
+      Obj_Type   : Entity_Id;
+      Actual     : Node_Id;
+      Last_Node  : Node_Id;
+      --  Last_Node is used to free all the nodes generated while trying the
+      --  alternatives. NOTE: This must be removed because it is considered
+      --  too low level
+      use Atree_Private_Part;
+
+      function Try_Replacement
+        (New_Prefix : Entity_Id;
+         New_Subprg : Node_Id;
+         New_Formal : Node_Id;
+         Nam_Ent    : Entity_Id) return Boolean;
+      --  Replace the node with the Object.Operation notation by the
+      --  equivalent node with the Package.Operation (Object, ...) notation
+      --
+      --  Nam_Ent is the entity that provides the formals against which
+      --  the actuals are checked. If the actuals are compatible with
+      --  Ent_Nam, this function returns true.
+
+      function Try_Primitive_Operations
+        (New_Prefix : Entity_Id;
+         New_Subprg : Node_Id;
+         Obj        : Node_Id;
+         Obj_Type   : Entity_Id) return Boolean;
+      --  Traverse the list of primitive subprograms to look for the
+      --  subprogram.
+
+      function Try_Class_Wide_Operation
+        (New_Subprg : Node_Id;
+         Obj        : Node_Id;
+         Obj_Type   : Entity_Id) return Boolean;
+      --  Traverse all the ancestor types to look for a class-wide
+      --  subprogram
+
+      ------------------------------
+      -- Try_Primitive_Operations --
+      ------------------------------
+
+      function Try_Primitive_Operations
+        (New_Prefix : Entity_Id;
+         New_Subprg : Node_Id;
+         Obj        : Node_Id;
+         Obj_Type   : Entity_Id) return Boolean
+      is
+         Deref      : Node_Id;
+         Elmt       : Elmt_Id;
+         Prim_Op    : Entity_Id;
+
+      begin
+         --  Look for the subprogram in the list of primitive operations.
+         --  This case is simple because all the primitive operations are
+         --  implicitly inherited and thus we have a candidate as soon as
+         --  we find a primitive subprogram with the same name. The latter
+         --  analysis after the node replacement will resolve it.
+
+         Elmt := First_Elmt (Primitive_Operations (Obj_Type));
+
+         while Present (Elmt) loop
+            Prim_Op := Node (Elmt);
+
+            if Chars (Prim_Op) = Chars (New_Subprg) then
+               if Try_Replacement (New_Prefix => New_Prefix,
+                                   New_Subprg => New_Subprg,
+                                   New_Formal => Obj,
+                                   Nam_Ent    => Prim_Op)
+               then
+                  return True;
+
+               --  Try the implicit dereference in case of access type
+
+               elsif Is_Access_Type (Etype (Obj)) then
+                  Deref := Make_Explicit_Dereference (Sloc (Obj), Obj);
+                  Set_Etype (Deref, Obj_Type);
+
+                  if Try_Replacement (New_Prefix => New_Prefix,
+                                      New_Subprg => New_Subprg,
+                                      New_Formal => Deref,
+                                      Nam_Ent    => Prim_Op)
+                  then
+                     return True;
+                  end if;
+               end if;
+            end if;
+
+            Next_Elmt (Elmt);
+         end loop;
+
+         return False;
+      end Try_Primitive_Operations;
+
+      ------------------------------
+      -- Try_Class_Wide_Operation --
+      ------------------------------
+
+      function Try_Class_Wide_Operation
+        (New_Subprg : Node_Id;
+         Obj        : Node_Id;
+         Obj_Type   : Entity_Id) return Boolean
+      is
+         Deref      : Node_Id;
+         Hom        : Entity_Id;
+         Typ        : Entity_Id;
+
+      begin
+         Typ := Obj_Type;
+
+         loop
+            --  For each parent subtype we traverse all the homonym chain
+            --  looking for a candidate class-wide subprogram
+
+            Hom := Current_Entity (New_Subprg);
+
+            while Present (Hom) loop
+               if (Ekind (Hom) = E_Procedure
+                     or else Ekind (Hom) = E_Function)
+                   and then Present (First_Entity (Hom))
+                   and then Etype (First_Entity (Hom)) = Class_Wide_Type (Typ)
+               then
+                  if Try_Replacement
+                    (New_Prefix => Scope (Hom),
+                     New_Subprg => Make_Identifier (Sloc (N), Chars (Hom)),
+                     New_Formal => Obj,
+                     Nam_Ent    => Hom)
+                  then
+                     return True;
+
+                  --  Try the implicit dereference in case of access type
+
+                  elsif Is_Access_Type (Etype (Obj)) then
+                     Deref := Make_Explicit_Dereference (Sloc (Obj), Obj);
+                     Set_Etype (Deref, Obj_Type);
+
+                     if Try_Replacement
+                       (New_Prefix => Scope (Hom),
+                        New_Subprg => Make_Identifier (Sloc (N), Chars (Hom)),
+                        New_Formal => Deref,
+                        Nam_Ent    => Hom)
+                     then
+                        return True;
+                     end if;
+                  end if;
+               end if;
+
+               Hom := Homonym (Hom);
+            end loop;
+
+            exit when Etype (Typ) = Typ;
+
+            Typ := Etype (Typ); --  Climb to the ancestor type
+         end loop;
+
+         return False;
+      end Try_Class_Wide_Operation;
+
+      ---------------------
+      -- Try_Replacement --
+      ---------------------
+
+      function Try_Replacement
+        (New_Prefix : Entity_Id;
+         New_Subprg : Node_Id;
+         New_Formal : Node_Id;
+         Nam_Ent    : Entity_Id) return Boolean
+      is
+         Loc             : constant Source_Ptr := Sloc (N);
+         Call_Node       : Node_Id;
+         New_Name        : Node_Id;
+         New_Actuals     : List_Id;
+         Node_To_Replace : Node_Id;
+         Success         : Boolean;
+
+      begin
+         --  Step 1. Build the replacement node: a subprogram call node
+         --  with the object as its first actual parameter
+
+         New_Name := Make_Selected_Component (Loc,
+                       Prefix        => New_Reference_To (New_Prefix, Loc),
+                       Selector_Name => New_Copy_Tree (New_Subprg));
+
+         New_Actuals := New_List (New_Copy_Tree (New_Formal));
+
+         if (Nkind (Parent (N)) = N_Procedure_Call_Statement
+               or else Nkind (Parent (N)) = N_Function_Call)
+             and then N /= First (Parameter_Associations (Parent (N)))
+               --  Protect against recursive call; It occurs in "..:= F (O.P)"
+         then
+            Node_To_Replace := Parent (N);
+
+            Append_List_To
+              (New_Actuals,
+               New_Copy_List (Parameter_Associations (Node_To_Replace)));
+
+            if Nkind (Node_To_Replace) = N_Procedure_Call_Statement then
+               Call_Node :=
+                 Make_Procedure_Call_Statement (Loc, New_Name, New_Actuals);
+
+            else pragma Assert (Nkind (Node_To_Replace) = N_Function_Call);
+               Call_Node :=
+                 Make_Function_Call (Loc, New_Name, New_Actuals);
+            end if;
+
+         --  Case of a function without parameters
+
+         else
+            Node_To_Replace := N;
+
+            Call_Node :=
+              Make_Function_Call (Loc, New_Name, New_Actuals);
+         end if;
+
+         --  Step 2. Analyze the candidate replacement node. If it was
+         --  successfully analyzed then replace the original node and
+         --  carry out the full analysis to verify that there is no
+         --  conflict with overloaded subprograms.
+
+         --  To properly analyze the candidate we must initialize the type
+         --  of the result node of the call to the error type; it will be
+         --  reset if the type is successfully resolved.
+
+         Set_Etype (Call_Node, Any_Type);
+
+         Analyze_One_Call
+           (N       => Call_Node,
+            Nam     => Nam_Ent,
+            Report  => False,  -- do not post errors
+            Success => Success);
+
+         if Success then
+            --  Previous analysis transformed the node with the name
+            --  and we have to reset it to properly re-analyze it.
+
+            New_Name := Make_Selected_Component (Loc,
+                          Prefix        => New_Reference_To (New_Prefix, Loc),
+                          Selector_Name => New_Copy_Tree (New_Subprg));
+            Set_Name (Call_Node, New_Name);
+
+            Set_Analyzed (Call_Node, False);
+            Set_Parent (Call_Node, Parent (Node_To_Replace));
+            Replace (Node_To_Replace, Call_Node);
+            Analyze (Node_To_Replace);
+            return True;
+
+         --  Free all the nodes used for this test and return
+         else
+            Nodes.Set_Last (Last_Node);
+            return False;
+         end if;
+      end Try_Replacement;
+
+   --  Start of processing for Try_Object_Operation
+
+   begin
+      --  Find the type of the object
+
+      Obj_Type := Etype (Obj);
+
+      if Is_Access_Type (Obj_Type) then
+         Obj_Type := Designated_Type (Obj_Type);
+      end if;
+
+      if Ekind (Obj_Type) = E_Private_Subtype then
+         Obj_Type := Base_Type (Obj_Type);
+      end if;
+
+      if Is_Class_Wide_Type (Obj_Type) then
+         Obj_Type := Etype (Class_Wide_Type (Obj_Type));
+      end if;
+
+      --  Analyze the actuals
+
+      if (Nkind (Parent (N)) = N_Procedure_Call_Statement
+            or else Nkind (Parent (N)) = N_Function_Call)
+          and then N /= First (Parameter_Associations (Parent (N)))
+            --  Protects against recursive call in case of "..:= F (O.Proc)"
+      then
+         Actual := First (Parameter_Associations (Parent (N)));
+
+         while Present (Actual) loop
+            Analyze (Actual);
+            Check_Parameterless_Call (Actual);
+            Next_Actual (Actual);
+         end loop;
+      end if;
+
+      Last_Node := Last_Node_Id;
+
+      return Try_Primitive_Operations
+               (New_Prefix => Scope (Obj_Type),
+                New_Subprg => Selector_Name (N),
+                Obj        => Obj,
+                Obj_Type   => Obj_Type)
+           or else
+             Try_Class_Wide_Operation
+               (New_Subprg => Selector_Name (N),
+                Obj        => Obj,
+                Obj_Type   => Obj_Type);
+   end Try_Object_Operation;
+
 end Sem_Ch4;