2014-08-04 Robert Dewar <dewar@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case Pred):
	Remove special test for Float'First, no longer required.
	(Expand_N_Attribute_Reference, case Succ): Remove special test
	for Float'First, no longer required.
	* s-fatgen.adb (Pred): return infinity unchanged.
	(Succ): ditto.

2014-08-04  Claire Dross  <dross@adacore.com>

	* sem_ch12.adb (Analyze_Associations): Defaults should only be
	used if there is no explicit match.
	* exp_util.adb (Get_First_Parent_With_Ext_Axioms_For_Entity):
	Also check for pragma external_axiomatization on generic units.



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

5 files changed, 60 insertions, 82 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 39ace1f7878..b273bfc7fa2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,21 @@
 2014-08-04  Robert Dewar  <dewar@adacore.com>
 
+	* exp_attr.adb (Expand_N_Attribute_Reference, case Pred):
+	Remove special test for Float'First, no longer required.
+	(Expand_N_Attribute_Reference, case Succ): Remove special test
+	for Float'First, no longer required.
+	* s-fatgen.adb (Pred): return infinity unchanged.
+	(Succ): ditto.
+
+2014-08-04  Claire Dross  <dross@adacore.com>
+
+	* sem_ch12.adb (Analyze_Associations): Defaults should only be
+	used if there is no explicit match.
+	* exp_util.adb (Get_First_Parent_With_Ext_Axioms_For_Entity):
+	Also check for pragma external_axiomatization on generic units.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
 	* checks.adb (Activate_Overflow_Check): Remove
 	Check_Float_Overflow processing.
 	(Apply_Scalar_Range_Check): Ditto.
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 4e1ba7f5ce8..bb1b6b6a4b6 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4859,10 +4859,9 @@ package body Exp_Attr is
       -- Pred --
       ----------
 
-      --  1. Deal with enumeration types with holes
-      --  2. For floating-point, generate call to attribute function and deal
-      --       with range checking if Check_Float_Overflow mode is set.
-      --  3. For other cases, deal with constraint checking
+      --  1. Deal with enumeration types with holes.
+      --  2. For floating-point, generate call to attribute function.
+      --  3. For other cases, deal with constraint checking.
 
       when Attribute_Pred => Pred :
       declare
@@ -4934,35 +4933,9 @@ package body Exp_Attr is
 
          --  For floating-point, we transform 'Pred into a call to the Pred
          --  floating-point attribute function in Fat_xxx (xxx is root type).
+         --  Note that this function takes care of the overflow case.
 
          elsif Is_Floating_Point_Type (Ptyp) then
-
-            --  Handle case of range check. The Do_Range_Check flag is set only
-            --  in Check_Float_Overflow mode, and what we need is a specific
-            --  check against typ'First, since that is the only overflow case.
-
-            declare
-               Expr : constant Node_Id := First (Exprs);
-            begin
-               if Do_Range_Check (Expr) then
-                  Set_Do_Range_Check (Expr, False);
-                  Insert_Action (N,
-                    Make_Raise_Constraint_Error (Loc,
-                      Condition =>
-                        Make_Op_Eq (Loc,
-                          Left_Opnd  => Duplicate_Subexpr (Expr),
-                          Right_Opnd =>
-                            Make_Attribute_Reference (Loc,
-                              Attribute_Name => Name_First,
-                              Prefix         =>
-                                New_Occurrence_Of (Base_Type (Ptyp), Loc))),
-                      Reason => CE_Overflow_Check_Failed),
-                  Suppress => All_Checks);
-               end if;
-            end;
-
-            --  Transform into call to attribute function
-
             Expand_Fpt_Attribute_R (N);
             Analyze_And_Resolve (N, Typ);
 
@@ -5889,9 +5862,9 @@ package body Exp_Attr is
       -- Succ --
       ----------
 
-      --  1. Deal with enumeration types with holes
-      --  2. For floating-point, generate call to attribute function
-      --  3. For other cases, deal with constraint checking
+      --  1. Deal with enumeration types with holes.
+      --  2. For floating-point, generate call to attribute function.
+      --  3. For other cases, deal with constraint checking.
 
       when Attribute_Succ => Succ : declare
          Etyp : constant Entity_Id := Base_Type (Ptyp);
@@ -5960,33 +5933,6 @@ package body Exp_Attr is
          --  floating-point attribute function in Fat_xxx (xxx is root type)
 
          elsif Is_Floating_Point_Type (Ptyp) then
-
-            --  Handle case of range check. The Do_Range_Check flag is set only
-            --  in Check_Float_Overflow mode, and what we need is a specific
-            --  check against typ'Last, since that is the only overflow case.
-
-            declare
-               Expr : constant Node_Id := First (Exprs);
-            begin
-               if Do_Range_Check (Expr) then
-                  Set_Do_Range_Check (Expr, False);
-                  Insert_Action (N,
-                    Make_Raise_Constraint_Error (Loc,
-                      Condition =>
-                        Make_Op_Eq (Loc,
-                          Left_Opnd  => Duplicate_Subexpr (Expr),
-                          Right_Opnd =>
-                            Make_Attribute_Reference (Loc,
-                              Attribute_Name => Name_Last,
-                              Prefix         =>
-                                New_Occurrence_Of (Base_Type (Ptyp), Loc))),
-                      Reason    => CE_Overflow_Check_Failed),
-                    Suppress => All_Checks);
-               end if;
-            end;
-
-            --  Transform into call to attribute function
-
             Expand_Fpt_Attribute_R (N);
             Analyze_And_Resolve (N, Typ);
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c1fca54fe49..481fc37115a 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3292,8 +3292,8 @@ package body Exp_Util is
    -------------------------------------------------
 
    function Get_First_Parent_With_Ext_Axioms_For_Entity
-     (E : Entity_Id) return Entity_Id is
-
+     (E : Entity_Id) return Entity_Id
+   is
       Decl : Node_Id;
 
    begin
@@ -3305,9 +3305,9 @@ package body Exp_Util is
          end if;
       end if;
 
-      --  E is the package which is externally axiomatized
+      --  E is the package or generic package which is externally axiomatized
 
-      if Ekind (E) = E_Package
+      if Ekind_In (E, E_Package, E_Generic_Package)
         and then Has_Annotate_Pragma_For_External_Axiomatization (E)
       then
          return E;
@@ -3318,14 +3318,14 @@ package body Exp_Util is
       elsif Ekind (E) = E_Package
         and then Present (Generic_Parent (Decl))
       then
-         return Get_First_Parent_With_Ext_Axioms_For_Entity
-           (Generic_Parent (Decl));
+         return
+           Get_First_Parent_With_Ext_Axioms_For_Entity (Generic_Parent (Decl));
 
          --  Otherwise, look at E's scope instead if present
 
       elsif Present (Scope (E)) then
-         return Get_First_Parent_With_Ext_Axioms_For_Entity
-             (Scope (E));
+         return
+           Get_First_Parent_With_Ext_Axioms_For_Entity (Scope (E));
 
          --  Else there is no such axiomatized package
 
diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb
index 62534f67c38..1f4c4985762 100644
--- a/gcc/ada/s-fatgen.adb
+++ b/gcc/ada/s-fatgen.adb
@@ -426,6 +426,11 @@ package body System.Fat_Gen is
             return X / (X - X);
          end if;
 
+      --  For infinities, return unchanged
+
+      elsif X < T'First or else X > T'Last then
+         return X;
+
       --  Subtract from the given number a number equivalent to the value
       --  of its least significant bit. Given that the most significant bit
       --  represents a value of 1.0 * radix ** (exp - 1), the value we want
@@ -675,6 +680,11 @@ package body System.Fat_Gen is
             return X / (X - X);
          end if;
 
+      --  For infinities, return unchanged
+
+      elsif X < T'First or else X > T'Last then
+         return X;
+
       --  Add to the given number a number equivalent to the value
       --  of its least significant bit. Given that the most significant bit
       --  represents a value of 1.0 * radix ** (exp - 1), the value we want
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f2e3eca8202..ada3adc76b8 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1680,21 +1680,27 @@ package body Sem_Ch12 is
                         --  If actual is an entity (function or operator),
                         --  build wrapper for it.
 
-                        if Present (Match)
-                          and then Nkind (Match) = N_Operator_Symbol
-                        then
-                           --  If the name is a default, find its visible
-                           --  entity at the point of instantiation.
+                        if Present (Match) then
+                           if Nkind (Match) = N_Operator_Symbol then
+                              --  If the name is a default, find its visible
+                              --  entity at the point of instantiation.
+
+                              if Is_Entity_Name (Match)
+                                and then No (Entity (Match))
+                              then
+                                 Find_Direct_Name (Match);
+                              end if;
 
-                           if Is_Entity_Name (Match)
-                             and then No (Entity (Match))
-                           then
-                              Find_Direct_Name (Match);
-                           end if;
+                              Append_To
+                                (Assoc,
+                                 Build_Wrapper
+                                   (Defining_Entity (Analyzed_Formal), Match));
 
-                           Append_To (Assoc,
-                             Build_Wrapper
-                               (Defining_Entity (Analyzed_Formal), Match));
+                           else
+                              Append_To (Assoc,
+                                         Instantiate_Formal_Subprogram
+                                           (Formal, Match, Analyzed_Formal));
+                           end if;
 
                         --  Ditto if formal is an operator with a default.