[multiple changes]

2012-07-17  Vincent Pucci  <pucci@adacore.com>

	* gnat_ugn.texi: GNAT dimensionality checking
	documentation updated with System.Dim.Mks modifications.

2012-07-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb: sloc of array init_proc is sloc of type declaration.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (get_call_site_action_for): Remove useless init
	expression for p.
	(get_action_description_for): Do not overwrite action->kind.

2012-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
	and Conversion_Added.  Add local constant Typ.
	Retrieve the original attribute after the arithmetic check
	machinery has modified the node. Add a conversion to the target
	type when the prefix of attribute Max_Size_In_Storage_Elements
	is a controlled type.

2012-07-17  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch6.adb (Expand_Inlined_Call): For each actual parameter
	of mode 'out' or 'in out' that denotes an entity, reset
	Last_Assignment on the entity so that any assignments to the
	corresponding formal in the inlining will not trigger spurious
	warnings about overwriting assignments.

From-SVN: r189570

5 files changed, 77 insertions, 24 deletions

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index f3a81a8..69c77a8 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3201,9 +3201,26 @@ package body Exp_Attr is
       -- Max_Size_In_Storage_Elements --
       ----------------------------------
 
-      when Attribute_Max_Size_In_Storage_Elements =>
+      when Attribute_Max_Size_In_Storage_Elements => declare
+         Typ  : constant Entity_Id := Etype (N);
+         Attr : Node_Id;
+
+         Conversion_Added : Boolean := False;
+         --  A flag which tracks whether the original attribute has been
+         --  wrapped inside a type conversion.
+
+      begin
          Apply_Universal_Integer_Attribute_Checks (N);
 
+         --  The universal integer check may sometimes add a type conversion,
+         --  retrieve the original attribute reference from the expression.
+
+         Attr := N;
+         if Nkind (Attr) = N_Type_Conversion then
+            Attr := Expression (Attr);
+            Conversion_Added := True;
+         end if;
+
          --  Heap-allocated controlled objects contain two extra pointers which
          --  are not part of the actual type. Transform the attribute reference
          --  into a runtime expression to add the size of the hidden header.
@@ -3212,20 +3229,20 @@ package body Exp_Attr is
          --  two pointers are already present in the type.
 
          if VM_Target = No_VM
-           and then Nkind (N) = N_Attribute_Reference
+           and then Nkind (Attr) = N_Attribute_Reference
            and then Needs_Finalization (Ptyp)
-           and then not Header_Size_Added (N)
+           and then not Header_Size_Added (Attr)
          then
-            Set_Header_Size_Added (N);
+            Set_Header_Size_Added (Attr);
 
             --  Generate:
             --    P'Max_Size_In_Storage_Elements +
             --      Universal_Integer
             --        (Header_Size_With_Padding (Ptyp'Alignment))
 
-            Rewrite (N,
+            Rewrite (Attr,
               Make_Op_Add (Loc,
-                Left_Opnd  => Relocate_Node (N),
+                Left_Opnd  => Relocate_Node (Attr),
                 Right_Opnd =>
                   Convert_To (Universal_Integer,
                     Make_Function_Call (Loc,
@@ -3239,9 +3256,19 @@ package body Exp_Attr is
                             New_Reference_To (Ptyp, Loc),
                           Attribute_Name => Name_Alignment))))));
 
-            Analyze (N);
+            --  Add a conversion to the target type
+
+            if not Conversion_Added then
+               Rewrite (Attr,
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Typ, Loc),
+                   Expression   => Relocate_Node (Attr)));
+            end if;
+
+            Analyze (Attr);
             return;
          end if;
+      end;
 
       --------------------
       -- Mechanism_Code --
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 978e1b8..91c8833 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -518,11 +518,11 @@ package body Exp_Ch3 is
    ---------------------------
 
    procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
-      Loc              : constant Source_Ptr := Sloc (Nod);
       Comp_Type        : constant Entity_Id  := Component_Type (A_Type);
       Body_Stmts       : List_Id;
       Has_Default_Init : Boolean;
       Index_List       : List_Id;
+      Loc              : Source_Ptr;
       Proc_Id          : Entity_Id;
 
       function Init_Component return List_Id;
@@ -631,6 +631,19 @@ package body Exp_Ch3 is
    --  Start of processing for Build_Array_Init_Proc
 
    begin
+      --  The init proc is created when analyzing the freeze node for the type,
+      --  but it properly belongs with the array type declaration. However, if
+      --  the freeze node is for a subtype of a type declared in another unit
+      --  it seems preferable to use the freeze node as the source location of
+      --  of the init.proc. In any case this is preferable for gcov usage, and
+      --  the Sloc is not otherwise used by the compiler.
+
+      if In_Open_Scopes (Scope (A_Type)) then
+         Loc := Sloc (A_Type);
+      else
+         Loc := Sloc (Nod);
+      end if;
+
       --  Nothing to generate in the following cases:
 
       --    1. Initialization is suppressed for the type
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index eb37fa3..bbf2126 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4846,6 +4846,16 @@ package body Exp_Ch6 is
             return;
          end if;
 
+         --  Reset Last_Assignment for any parameters of mode out or in out, to
+         --  prevent spurious warnings about overwriting for assignments to the
+         --  formal in the inlined code.
+
+         if Is_Entity_Name (A)
+           and then Ekind (F) /= E_In_Parameter
+         then
+            Set_Last_Assignment (Entity (A), Empty);
+         end if;
+
          --  If the argument may be a controlling argument in a call within
          --  the inlined body, we must preserve its classwide nature to insure
          --  that dynamic dispatching take place subsequently. If the formal
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 0edaed0..c1ea83b 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -18684,13 +18684,13 @@ package, in file s-dimmks.ads.
    type Mks_Type is new Long_Long_Float
      with
       Dimension_System => (
-        (Meter,    'm'),
-        (Kilogram, "kg"),
-        (Second,   's'),
-        (Ampere,   'A'),
-        (Kelvin,   'K'),
-        (Mole,     "mol"),
-        (Candela,  "cd"));
+        (Unit_Name => Meter,    Unit_Symbol => 'm',   Dim_Symbol => 'L'),
+        (Unit_Name => Kilogram, Unit_Symbol => "kg",  Dim_Symbol => 'M'),
+        (Unit_Name => Second,   Unit_Symbol => 's',   Dim_Symbol => 'T'),
+        (Unit_Name => Ampere,   Unit_Symbol => 'A',   Dim_Symbol => 'I'),
+        (Unit_Name => Kelvin,   Unit_Symbol => 'K',   Dim_Symbol => "Theta"),
+        (Unit_Name => Mole,     Unit_Symbol => "mol", Dim_Symbol => 'N'),
+        (Unit_Name => Candela,  Unit_Symbol => "cd",  Dim_Symbol => 'J'));
 @end smallexample
 
 @noindent
@@ -18699,8 +18699,8 @@ conventional units. For example:
 @smallexample @c ada
    subtype Length is Mks_Type
      with
-      Dimension => ('m',
-        Meter =>  1,
+      Dimension => (Symbol => 'm',
+        Meter  => 1,
         others => 0);
 @end smallexample
 @noindent
@@ -18712,10 +18712,10 @@ The package also defines conventional names for values of each unit, for
 example:
 
 @smallexample @c ada
-   m   : constant Length                    := 1.0;
-   kg  : constant Mass                      := 1.0;
-   s   : constant Time                      := 1.0;
-   A   : constant Electric_Current          := 1.0;
+   m   : constant Length           := 1.0;
+   kg  : constant Mass             := 1.0;
+   s   : constant Time             := 1.0;
+   A   : constant Electric_Current := 1.0;
 @end smallexample
 
 @noindent
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 418e080..4da4bd2 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -710,7 +710,7 @@ get_call_site_action_for (_Unwind_Ptr call_site,
   else
     {
       _uleb128_t cs_lp, cs_action;
-      const unsigned char *p = region->call_site_table;
+      const unsigned char *p;
 
       /* Let the caller know there may be an action to take, but let it
 	 determine the kind.  */
@@ -947,13 +947,16 @@ get_action_description_for (_Unwind_Ptr ip,
                  passed (to follow the ABI).  */
               if (!(uw_phase & _UA_FORCE_UNWIND))
                 {
+		  enum action_kind act;
+
                   /* See if the filter we have is for an exception which
                      matches the one we are propagating.  */
                   _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
 
-		  action->kind = is_handled_by (choice, gnat_exception);
-                  if (action->kind != nothing)
+		  act = is_handled_by (choice, gnat_exception);
+                  if (act != nothing)
                     {
+		      action->kind = act;
                       action->ttype_filter = ar_filter;
                       return;
                     }