[multiple changes]

2009-11-30  Vincent Celier  <celier@adacore.com>

	* gnatlink.adb (Process_Args): Call Executable_Name on argument of -o
	with Only_If_No_Suffix set to True.
	* osint.adb (Executable_Name): Do not add executable suffix if there is
	already a suffix and Only_If_No_Suffix is True.
	* osint.ads (Executable_Name): New Boolean parameter Only_If_No_Suffix,
	defaulted to False.

2009-11-30  Javier Miranda  <miranda@adacore.com>

	* exp_atag.adb (Build_TSD): Change argument name because the actual is
	now the address of a tag (instead of the tag). Update implementation
	accordingly.
	(Build_CW_Membership): New implementation. Converted into a procedure
	because it has an additional out mode parameter. Its implementation has
	been rewritten to improve the generated code but also to facilitate
	referencing the relocated object node in the caller.
	* exp_atag.ads (Build_CW_Membership): Update profile and documentation.
	* sinfo.ads (N_SCIL_Membership_Test) New_Node.
	(SCIL_Tag_Value): New field of N_SCIL_Membership_Test nodes.
	(Is_Syntactic_Field): Add entry of new node.
	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
	* sinfo.adb (SCIL_Related_Node, SCIL_Entity): Update assertions to
	handle N_SCIL_Membership_Test nodes.
	(SCIL_Tag_Value/Set_SCIL_Tag_Value): New subprograms.
	* sem.adb (Analyze): Add null management for new node.
	* sem_scil.adb (Find_SCIL_Node): Add null management for new node.
	(Check_SCIL_Node): Add checks of N_SCIL_Membership_Test nodes.
	* exp_ch4.adb (Tagged_Membership): Change profile from function to
	procedure. Add generation of SCIL node associated with class-wide
	membership test.
	(Expand_N_In): Complete decoration of SCIL nodes.
	* exp_intr.adb (Expand_Dispatching_Constructor_Call): Tune call to
	Build_CW_Membership because its profile has been changed.
	* exp_util.adb (Insert_Actions): Add null management for new node.
	* sprint.adb (Sprint_Node_Actual): Handle new node.
	* gcc-interface/trans.c Add no processing for N_SCIL_Membership_Test
	nodes.
	* gcc-interface/Make-lang.in: Update dependencies.

2009-11-30  Ed Schonberg  <schonberg@adacore.com>

	* opt.ads: New flags Init_Or_Norm_Scalars_Config,
	Initialize_Scalars_Config, to capture the presence of the corresponding
	pragmas in a configuration file.
	* opt.adb (Register_, Save_, Set_, Restore_Opt_Configuration_Switches):
	handle new flags so that they are restored for each compilation unit.
	* frontend.adb: At the end of compilation, scan the context of the main
	unit to recover occurrences of pragma Initialize_Scalars, to annotate
	the ALI file accordingly.

From-SVN: r154792

1 files changed, 58 insertions, 20 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index dd74a15..4f0ef91 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -205,7 +205,10 @@ package body Exp_Ch4 is
    --  its expression. If N is neither comparison nor a type conversion, the
    --  call has no effect.
 
-   function Tagged_Membership (N : Node_Id) return Node_Id;
+   procedure Tagged_Membership
+     (N         : Node_Id;
+      SCIL_Node : out Node_Id;
+      Result    : out Node_Id);
    --  Construct the expression corresponding to the tagged membership test.
    --  Deals with a second operand being (or not) a class-wide type.
 
@@ -4503,10 +4506,12 @@ package body Exp_Ch4 is
 
       else
          declare
-            Typ    : Entity_Id        := Etype (Rop);
-            Is_Acc : constant Boolean := Is_Access_Type (Typ);
-            Obj    : Node_Id          := Lop;
-            Cond   : Node_Id          := Empty;
+            Typ       : Entity_Id        := Etype (Rop);
+            Is_Acc    : constant Boolean := Is_Access_Type (Typ);
+            Cond      : Node_Id          := Empty;
+            New_N     : Node_Id;
+            Obj       : Node_Id          := Lop;
+            SCIL_Node : Node_Id;
 
          begin
             Remove_Side_Effects (Obj);
@@ -4521,8 +4526,19 @@ package body Exp_Ch4 is
                --  normal tagged membership expansion is not what we want).
 
                if Tagged_Type_Expansion then
-                  Rewrite (N, Tagged_Membership (N));
+                  Tagged_Membership (N, SCIL_Node, New_N);
+                  Rewrite (N, New_N);
                   Analyze_And_Resolve (N, Rtyp);
+
+                  --  Update decoration of relocated node referenced by the
+                  --  SCIL node.
+
+                  if Generate_SCIL
+                    and then Present (SCIL_Node)
+                  then
+                     Set_SCIL_Related_Node (SCIL_Node, N);
+                     Insert_Action (N, SCIL_Node);
+                  end if;
                end if;
 
                return;
@@ -9857,16 +9873,23 @@ package body Exp_Ch4 is
    --  table of abstract interface types plus the ancestor table contained in
    --  the dispatch table pointed by Left_Expr.Tag for Typ'Tag
 
-   function Tagged_Membership (N : Node_Id) return Node_Id is
+   procedure Tagged_Membership
+     (N         : Node_Id;
+      SCIL_Node : out Node_Id;
+      Result    : out Node_Id)
+   is
       Left  : constant Node_Id    := Left_Opnd  (N);
       Right : constant Node_Id    := Right_Opnd (N);
       Loc   : constant Source_Ptr := Sloc (N);
 
       Left_Type  : Entity_Id;
+      New_Node   : Node_Id;
       Right_Type : Entity_Id;
       Obj_Tag    : Node_Id;
 
    begin
+      SCIL_Node := Empty;
+
       --  Handle entities from the limited view
 
       Left_Type  := Available_View (Etype (Left));
@@ -9914,7 +9937,8 @@ package body Exp_Ch4 is
                                            (Typ   => Left_Type,
                                             Iface => Etype (Right_Type))))
          then
-            return New_Reference_To (Standard_True, Loc);
+            Result := New_Reference_To (Standard_True, Loc);
+            return;
          end if;
 
          --  Ada 2005 (AI-251): Class-wide applied to interfaces
@@ -9931,10 +9955,11 @@ package body Exp_Ch4 is
             if not RTE_Available (RE_IW_Membership) then
                Error_Msg_CRT
                  ("dynamic membership test on interface types", N);
-               return Empty;
+               Result := Empty;
+               return;
             end if;
 
-            return
+            Result :=
               Make_Function_Call (Loc,
                  Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc),
                  Parameter_Associations => New_List (
@@ -9949,14 +9974,27 @@ package body Exp_Ch4 is
          --  Ada 95: Normal case
 
          else
-            return
-              Build_CW_Membership (Loc,
-                Obj_Tag_Node => Obj_Tag,
-                Typ_Tag_Node =>
-                   New_Reference_To (
-                     Node (First_Elmt
-                            (Access_Disp_Table (Root_Type (Right_Type)))),
-                     Loc));
+            Build_CW_Membership (Loc,
+              Obj_Tag_Node => Obj_Tag,
+              Typ_Tag_Node =>
+                 New_Reference_To (
+                   Node (First_Elmt
+                          (Access_Disp_Table (Root_Type (Right_Type)))),
+                   Loc),
+              Related_Nod => N,
+              New_Node    => New_Node);
+
+            --  Generate the SCIL node for this class-wide membership test.
+            --  Done here because the previous call to Build_CW_Membership
+            --  relocates Obj_Tag.
+
+            if Generate_SCIL then
+               SCIL_Node := Make_SCIL_Membership_Test (Sloc (N));
+               Set_SCIL_Entity (SCIL_Node, Etype (Right_Type));
+               Set_SCIL_Tag_Value (SCIL_Node, Obj_Tag);
+            end if;
+
+            Result := New_Node;
          end if;
 
       --  Right_Type is not a class-wide type
@@ -9965,10 +10003,10 @@ package body Exp_Ch4 is
          --  No need to check the tag of the object if Right_Typ is abstract
 
          if Is_Abstract_Type (Right_Type) then
-            return New_Reference_To (Standard_False, Loc);
+            Result := New_Reference_To (Standard_False, Loc);
 
          else
-            return
+            Result :=
               Make_Op_Eq (Loc,
                 Left_Opnd  => Obj_Tag,
                 Right_Opnd =>