[multiple changes]

2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Refined_Pragma): Remove
	local variable Pack_Spec. Refinement pragmas may now apply to
	bodies of both visible and private subprograms.

2014-02-06  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_Loop_Entry_Attribute):
	Minor change (Attr => N) (Expand_Pred_Succ): New name
	Expand_Pred_Succ_Attribute (Expand_N_Attribute_Reference, case
	Max): Expand into if expression if Modify_Tree_For_C mode.
	(Expand_N_Attribute_Reference, case Min): ditto
	* sinfo.ads: Modify_Tree_For_C takes care of expanding Min and
	Max attributes.

2014-02-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): Do not generate
	predicate check if this is an internal declaration with
	No_Initialization set, as for an expanded aggregate component.

2014-02-06  Doug Rupp  <rupp@adacore.com>

	* init.c (__gnat_default_resignal_p) [VMS]: Test for and resignal
	conditions with severity of "SUCCESS" or "INFORMATIONAL".

From-SVN: r207559

6 files changed, 146 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 01f2489..d9ca753 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Refined_Pragma): Remove
+	local variable Pack_Spec. Refinement pragmas may now apply to
+	bodies of both visible and private subprograms.
+
+2014-02-06  Robert Dewar  <dewar@adacore.com>
+
+	* exp_attr.adb (Expand_Loop_Entry_Attribute):
+	Minor change (Attr => N) (Expand_Pred_Succ): New name
+	Expand_Pred_Succ_Attribute (Expand_N_Attribute_Reference, case
+	Max): Expand into if expression if Modify_Tree_For_C mode.
+	(Expand_N_Attribute_Reference, case Min): ditto
+	* sinfo.ads: Modify_Tree_For_C takes care of expanding Min and
+	Max attributes.
+
+2014-02-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Analyze_Object_Declaration): Do not generate
+	predicate check if this is an internal declaration with
+	No_Initialization set, as for an expanded aggregate component.
+
+2014-02-06  Doug Rupp  <rupp@adacore.com>
+
+	* init.c (__gnat_default_resignal_p) [VMS]: Test for and resignal
+	conditions with severity of "SUCCESS" or "INFORMATIONAL".
+
 2014-02-06  Yannick Moy  <moy@adacore.com>
 
 	* sem_prag.adb (Analyze_Pragma): Analyze pragma
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 624661c..c54fb78 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -136,11 +136,11 @@ package body Exp_Attr is
    --  that takes two floating-point arguments. The function to be called
    --  is always the same as the attribute name.
 
-   procedure Expand_Loop_Entry_Attribute (Attr : Node_Id);
+   procedure Expand_Loop_Entry_Attribute (N : Node_Id);
    --  Handle the expansion of attribute 'Loop_Entry. As a result, the related
    --  loop may be converted into a conditional block. See body for details.
 
-   procedure Expand_Pred_Succ (N : Node_Id);
+   procedure Expand_Pred_Succ_Attribute (N : Node_Id);
    --  Handles expansion of Pred or Succ attributes for case of non-real
    --  operand with overflow checking required.
 
@@ -657,7 +657,7 @@ package body Exp_Attr is
    -- Expand_Loop_Entry_Attribute --
    ---------------------------------
 
-   procedure Expand_Loop_Entry_Attribute (Attr : Node_Id) is
+   procedure Expand_Loop_Entry_Attribute (N : Node_Id) is
       procedure Build_Conditional_Block
         (Loc       : Source_Ptr;
          Cond      : Node_Id;
@@ -730,8 +730,8 @@ package body Exp_Attr is
 
       --  Local variables
 
-      Exprs     : constant List_Id   := Expressions (Attr);
-      Pref      : constant Node_Id   := Prefix (Attr);
+      Exprs     : constant List_Id   := Expressions (N);
+      Pref      : constant Node_Id   := Prefix (N);
       Typ       : constant Entity_Id := Etype (Pref);
       Blk       : Node_Id;
       Decls     : List_Id;
@@ -760,7 +760,7 @@ package body Exp_Attr is
       --  internally generated loops for quantified expressions.
 
       else
-         Loop_Stmt := Attr;
+         Loop_Stmt := N;
          while Present (Loop_Stmt) loop
             if Nkind (Loop_Stmt) = N_Loop_Statement
               and then Present (Identifier (Loop_Stmt))
@@ -1002,7 +1002,7 @@ package body Exp_Attr is
 
       --  Step 4: Analyze all bits
 
-      Rewrite (Attr, New_Reference_To (Temp_Id, Loc));
+      Rewrite (N, New_Reference_To (Temp_Id, Loc));
 
       Installed := Current_Scope = Scope (Loop_Id);
 
@@ -1028,7 +1028,7 @@ package body Exp_Attr is
          Analyze (Temp_Decl);
       end if;
 
-      Analyze (Attr);
+      Analyze (N);
 
       if not Installed then
          Pop_Scope;
@@ -3616,6 +3616,44 @@ package body Exp_Attr is
          Analyze_And_Resolve (N, Typ);
       end Mantissa;
 
+      ---------
+      -- Max --
+      ---------
+
+      when Attribute_Max =>
+
+         --  Max is handled by the back end (except that static cases have
+         --  already been evaluated during semantic processing, but anyway
+         --  the back end should not count on this). The one bit of special
+         --  processing required in the normal case is that this attribute
+         --  typically generates conditionals in the code, so we must check
+         --  the relevant restriction.
+
+         Check_Restriction (No_Implicit_Conditionals, N);
+
+         --  In Modify_Tree_For_C mode, we rewrite as an if expression
+
+         if Modify_Tree_For_C then
+            declare
+               Loc   : constant Source_Ptr := Sloc (N);
+               Typ   : constant Entity_Id  := Etype (N);
+               Expr  : constant Node_Id    := First (Expressions (N));
+               Left  : constant Node_Id    := Relocate_Node (Expr);
+               Right : constant Node_Id    := Relocate_Node (Next (Expr));
+
+            begin
+               Rewrite (N,
+                 Make_If_Expression (Loc,
+                   Expressions => New_List (
+                     Make_Op_Ge (Loc,
+                       Left_Opnd  => Left,
+                       Right_Opnd => Right),
+                     Duplicate_Subexpr_No_Checks (Left),
+                     Duplicate_Subexpr_No_Checks (Right))));
+               Analyze_And_Resolve (N, Typ);
+            end;
+         end if;
+
       ----------------------------------
       -- Max_Size_In_Storage_Elements --
       ----------------------------------
@@ -3704,6 +3742,44 @@ package body Exp_Attr is
          end if;
 
       ---------
+      -- Min --
+      ---------
+
+      when Attribute_Min =>
+
+         --  Min is handled by the back end (except that static cases have
+         --  already been evaluated during semantic processing, but anyway
+         --  the back end should not count on this). The one bit of special
+         --  processing required in the normal case is that this attribute
+         --  typically generates conditionals in the code, so we must check
+         --  the relevant restriction.
+
+         Check_Restriction (No_Implicit_Conditionals, N);
+
+         --  In Modify_Tree_For_C mode, we rewrite as an if expression
+
+         if Modify_Tree_For_C then
+            declare
+               Loc   : constant Source_Ptr := Sloc (N);
+               Typ   : constant Entity_Id  := Etype (N);
+               Expr  : constant Node_Id    := First (Expressions (N));
+               Left  : constant Node_Id    := Relocate_Node (Expr);
+               Right : constant Node_Id    := Relocate_Node (Next (Expr));
+
+            begin
+               Rewrite (N,
+                 Make_If_Expression (Loc,
+                   Expressions => New_List (
+                     Make_Op_Le (Loc,
+                       Left_Opnd  => Left,
+                       Right_Opnd => Right),
+                     Duplicate_Subexpr_No_Checks (Left),
+                     Duplicate_Subexpr_No_Checks (Right))));
+               Analyze_And_Resolve (N, Typ);
+            end;
+         end if;
+
+      ---------
       -- Mod --
       ---------
 
@@ -4378,7 +4454,7 @@ package body Exp_Attr is
            or else Do_Range_Check (First (Exprs))
          then
             Set_Do_Range_Check (First (Exprs), False);
-            Expand_Pred_Succ (N);
+            Expand_Pred_Succ_Attribute (N);
          end if;
       end Pred;
 
@@ -5426,7 +5502,7 @@ package body Exp_Attr is
            or else Do_Range_Check (First (Exprs))
          then
             Set_Do_Range_Check (First (Exprs), False);
-            Expand_Pred_Succ (N);
+            Expand_Pred_Succ_Attribute (N);
          end if;
       end Succ;
 
@@ -6440,17 +6516,6 @@ package body Exp_Attr is
 
       --  The following attributes are handled by the back end (except that
       --  static cases have already been evaluated during semantic processing,
-      --  but in any case the back end should not count on this). The one bit
-      --  of special processing required is that these attributes typically
-      --  generate conditionals in the code, so we need to check the relevant
-      --  restriction.
-
-      when Attribute_Max                          |
-           Attribute_Min                          =>
-         Check_Restriction (No_Implicit_Conditionals, N);
-
-      --  The following attributes are handled by the back end (except that
-      --  static cases have already been evaluated during semantic processing,
       --  but in any case the back end should not count on this).
 
       --  The back end also handles the non-class-wide cases of Size
@@ -6552,9 +6617,9 @@ package body Exp_Attr is
          return;
    end Expand_N_Attribute_Reference;
 
-   ----------------------
-   -- Expand_Pred_Succ --
-   ----------------------
+   --------------------------------
+   -- Expand_Pred_Succ_Attribute --
+   --------------------------------
 
    --  For typ'Pred (exp), we generate the check
 
@@ -6570,7 +6635,7 @@ package body Exp_Attr is
    --  statement or the expression of an object declaration, where the flag
    --  Suppress_Assignment_Checks is set for the assignment/declaration.
 
-   procedure Expand_Pred_Succ (N : Node_Id) is
+   procedure Expand_Pred_Succ_Attribute (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
       P    : constant Node_Id    := Parent (N);
       Cnam : Name_Id;
@@ -6598,7 +6663,7 @@ package body Exp_Attr is
                      Attribute_Name => Cnam)),
              Reason => CE_Overflow_Check_Failed));
       end if;
-   end Expand_Pred_Succ;
+   end Expand_Pred_Succ_Attribute;
 
    -----------------------------
    -- Expand_Update_Attribute --
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index e943837..fb94198 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -809,6 +809,7 @@ void (*__gnat_ctrl_c_handler) (void) = 0;
 /* Masks for facility identification. */
 #define FAC_MASK  		0x0fff0000
 #define DECADA_M_FACILITY	0x00310000
+#define SEVERITY_MASK		0x7
 
 /* Define macro symbols for the VMS conditions that become Ada exceptions.
    It would be better to just include <ssdef.h> */
@@ -1068,6 +1069,9 @@ __gnat_default_resignal_p (int code)
     if ((code & FAC_MASK) == facility_resignal_table [i])
       return 1;
 
+  if ((code & SEVERITY_MASK) == 1 || (code & SEVERITY_MASK) == 3)
+    return 1;
+
   for (i = 0, iexcept = 0;
        cond_resignal_table [i]
 	&& !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index cf5f4a6..c763bd6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3551,10 +3551,13 @@ package body Sem_Ch3 is
 
       --  We need a predicate check if the type has predicates, and if either
       --  there is an initializing expression, or for default initialization
-      --  when we have at least one case of an explicit default initial value.
+      --  when we have at least one case of an explicit default initial value
+      --  and then this is not an internal declaration whose initialization
+      --  comes later (as for an aggregate expansion).
 
       if not Suppress_Assignment_Checks (N)
         and then Present (Predicate_Function (T))
+        and then not No_Initialization (N)
         and then
           (Present (E)
             or else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4b304db..1f46ae2 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3616,7 +3616,6 @@ package body Sem_Prag is
          Legal   : out Boolean)
       is
          Body_Decl : Node_Id;
-         Pack_Spec : Node_Id;
          Spec_Decl : Node_Id;
 
       begin
@@ -3676,14 +3675,10 @@ package body Sem_Prag is
                                  N_Generic_Subprogram_Declaration,
                                  N_Subprogram_Declaration));
 
-         Pack_Spec := Parent (Spec_Decl);
-
-         if Nkind (Pack_Spec) /= N_Package_Specification
-           or else List_Containing (Spec_Decl) /=
-                     Visible_Declarations (Pack_Spec)
-         then
+         if Nkind (Parent (Spec_Decl)) /= N_Package_Specification then
             Error_Pragma
-              ("pragma % must apply to the body of a visible subprogram");
+              ("pragma % must apply to the body of a subprogram declared in a "
+               & "package specification");
             return;
          end if;
 
@@ -12622,13 +12617,14 @@ package body Sem_Prag is
                Freeze_Before (N, Entity (Name (Call)));
             end if;
 
-            Rewrite (N, Make_Implicit_If_Statement (N,
-              Condition       => Cond,
-              Then_Statements => New_List (
-                Make_Block_Statement (Loc,
-                  Handled_Statement_Sequence =>
-                    Make_Handled_Sequence_Of_Statements (Loc,
-                      Statements => New_List (Relocate_Node (Call)))))));
+            Rewrite (N,
+              Make_Implicit_If_Statement (N,
+                Condition       => Cond,
+                Then_Statements => New_List (
+                  Make_Block_Statement (Loc,
+                    Handled_Statement_Sequence =>
+                      Make_Handled_Sequence_Of_Statements (Loc,
+                        Statements => New_List (Relocate_Node (Call)))))));
             Analyze (N);
 
             --  Ignore pragma Debug in GNATprove mode. Do this rewriting
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index f399dab..0405c64 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -549,6 +549,9 @@ package Sinfo is
    --  not make sense from a user point-of-view, and that cross-references that
    --  do not lead to data dependences for subprograms can be safely ignored.
 
+   --  In addition pragma Debug statements are removed from the tree (rewritten
+   --  to NULL stmt), since they should be taken into account in flow analysis.
+
    -----------------------
    -- Check Flag Fields --
    -----------------------
@@ -636,6 +639,9 @@ package Sinfo is
    --    less than the word size (since other values are not well-defined in
    --    C). This is done using an explicit test if necessary.
 
+   --    Min and Max attributes are expanded into equivalent if expressions,
+   --    dealing properly with side effect issues.
+
    ------------------------------------
    -- Description of Semantic Fields --
    ------------------------------------
@@ -3589,6 +3595,9 @@ package Sinfo is
       --  Must_Be_Byte_Aligned (Flag14)
       --  plus fields for expression
 
+      --  Note: in Modify_Tree_For_C mode, Max and Min attributes are expanded
+      --  into equivalent if expressions, properly taking care of side effects.
+
       ---------------------------------
       -- 4.1.4  Attribute Designator --
       ---------------------------------