2016-04-19 Hristian Kirtchev <kirtchev@adacore.com>

	* checks.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
	reformatting.

2016-04-19  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Profile): Refine predicate that checks
	whether a function that returns a limited view is declared in
	another unit and cannot be frozen at this point.

2016-04-19  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Component_Count): Handle properly superflat
	arrays, i.e. empty arrays where Hi < Lo - 1, to ensure that the
	return value of the function is Natural, rather than leaving
	the handling of such arrays to the caller of this function.



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

7 files changed, 64 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7cc7ff9d410..3a514cd1d42 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2016-04-19  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
+	reformatting.
+
+2016-04-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Profile): Refine predicate that checks
+	whether a function that returns a limited view is declared in
+	another unit and cannot be frozen at this point.
+
+2016-04-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Component_Count): Handle properly superflat
+	arrays, i.e. empty arrays where Hi < Lo - 1, to ensure that the
+	return value of the function is Natural, rather than leaving
+	the handling of such arrays to the caller of this function.
+
 2016-04-19  Arnaud Charlet  <charlet@adacore.com>
 
 	* sem_prag.adb, sem_attr.adb, par-prag.adb, exp_aggr.adb, sem_type.adb
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index eca82d77818..47fe1bfe63f 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2354,11 +2354,13 @@ package body Checks is
 
       --  Local variables
 
-      Actual_1 : Node_Id;
-      Actual_2 : Node_Id;
-      Check    : Node_Id;
-      Formal_1 : Entity_Id;
-      Formal_2 : Entity_Id;
+      Actual_1   : Node_Id;
+      Actual_2   : Node_Id;
+      Check      : Node_Id;
+      Formal_1   : Entity_Id;
+      Formal_2   : Entity_Id;
+      Orig_Act_1 : Node_Id;
+      Orig_Act_2 : Node_Id;
 
    --  Start of processing for Apply_Parameter_Aliasing_Checks
 
@@ -2368,6 +2370,7 @@ package body Checks is
       Actual_1 := First_Actual (Call);
       Formal_1 := First_Formal (Subp);
       while Present (Actual_1) and then Present (Formal_1) loop
+         Orig_Act_1 := Original_Actual (Actual_1);
 
          --  Ensure that the actual is an object that is not passed by value.
          --  Elementary types are always passed by value, therefore actuals of
@@ -2378,30 +2381,27 @@ package body Checks is
          --  will be done in place and a subsequent read will always see the
          --  correct value, see RM 6.2 (12/3).
 
-         if Nkind (Original_Actual (Actual_1)) = N_Aggregate
-           or else
-             (Nkind (Original_Actual (Actual_1)) = N_Qualified_Expression
-                and then Nkind (Expression (Original_Actual (Actual_1))) =
-                           N_Aggregate)
+         if Nkind (Orig_Act_1) = N_Aggregate
+           or else (Nkind (Orig_Act_1) = N_Qualified_Expression
+                     and then Nkind (Expression (Orig_Act_1)) = N_Aggregate)
          then
             null;
 
-         elsif Is_Object_Reference (Original_Actual (Actual_1))
-           and then not Is_Elementary_Type (Etype (Original_Actual (Actual_1)))
-           and then
-              not Is_By_Reference_Type (Etype (Original_Actual (Actual_1)))
+         elsif Is_Object_Reference (Orig_Act_1)
+           and then not Is_Elementary_Type (Etype (Orig_Act_1))
+           and then not Is_By_Reference_Type (Etype (Orig_Act_1))
          then
             Actual_2 := Next_Actual (Actual_1);
             Formal_2 := Next_Formal (Formal_1);
             while Present (Actual_2) and then Present (Formal_2) loop
+               Orig_Act_2 := Original_Actual (Actual_2);
 
                --  The other actual we are testing against must also denote
                --  a non pass-by-value object. Generate the check only when
                --  the mode of the two formals may lead to aliasing.
 
-               if Is_Object_Reference (Original_Actual (Actual_2))
-                 and then not
-                   Is_Elementary_Type (Etype (Original_Actual (Actual_2)))
+               if Is_Object_Reference (Orig_Act_2)
+                 and then not Is_Elementary_Type (Etype (Orig_Act_2))
                  and then May_Cause_Aliasing (Formal_1, Formal_2)
                then
                   Overlap_Check
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cb97dca4d7c..94f8e0745ec 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -354,10 +354,16 @@ package body Exp_Aggr is
                Siz : constant Nat := Component_Count (Component_Type (T));
 
             begin
+               --  Check for superflat arrays, i.e. arrays with such bounds
+               --  as 4 .. 2, to insure that this function never returns a
+               --  meaningless negative value.
+
                if not Compile_Time_Known_Value (Lo)
                  or else not Compile_Time_Known_Value (Hi)
+                 or else Expr_Value (Hi) < Expr_Value (Lo)
                then
                   return 0;
+
                else
                   return
                     Siz * UI_To_Int (Expr_Value (Hi) - Expr_Value (Lo) + 1);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index dd91f8028a1..f23e168bd22 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3288,12 +3288,14 @@ package body Freeze is
 
          if Ekind (E) = E_Function then
 
-            --  Check whether function is declared elsewhere.
+            --  Check whether function is declared elsewhere. Previous code
+            --  used Get_Source_Unit on both arguments, but the values are
+            --  equal in the case of a parent and a child unit.
+            --  Confusion with subunits in code  ????
 
             Late_Freezing :=
-              Get_Source_Unit (E) /= Get_Source_Unit (N)
-                and then Returns_Limited_View (E)
-                and then not In_Open_Scopes (Scope (E));
+              not In_Same_Extended_Unit (E, N)
+                and then Returns_Limited_View (E);
 
             --  Freeze return type
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index fa44c1d96d6..66c6432dddf 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10094,11 +10094,10 @@ package body Sem_Attr is
                      Freeze_Before (N, Entity (P));
                   end if;
 
-               --    If it is a type, there is nothing to resolve.
-               --    If it is an object, complete its resolution.
+               --  If it is a type, there is nothing to resolve. If it is an
+               --  object, complete its resolution.
 
                elsif Is_Overloadable (Entity (P)) then
-
                   if not In_Spec_Expression then
                      Freeze_Before (N, Entity (P));
                   end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 85bf0c40963..29c56120650 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6963,8 +6963,8 @@ package body Sem_Res is
             then
                null;
             else
-               Error_Msg_N (
-                 "deferred constant is frozen before completion", N);
+               Error_Msg_N
+                 ("deferred constant is frozen before completion", N);
             end if;
          end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d4a276ca5d8..0d9b4d14394 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13103,9 +13103,9 @@ package body Sem_Util is
 
          Par := Nod;
          while Present (Par) loop
-            if Nkind_In (Par, N_Function_Call,
-                              N_Procedure_Call_Statement,
-                              N_Entry_Call_Statement)
+            if Nkind_In (Par, N_Entry_Call_Statement,
+                              N_Function_Call,
+                              N_Procedure_Call_Statement)
             then
                return True;
 
@@ -15978,22 +15978,20 @@ package body Sem_Util is
             if New_Sloc /= No_Location then
                Set_Sloc (New_Node, New_Sloc);
 
-               --  If we adjust the Sloc, then we are essentially making
-               --  a completely new node, so the Comes_From_Source flag
-               --  should be reset to the proper default value.
-
-               Set_Comes_From_Source (New_Node,
-                                      Default_Node.Comes_From_Source);
+               --  If we adjust the Sloc, then we are essentially making a
+               --  completely new node, so the Comes_From_Source flag should
+               --  be reset to the proper default value.
 
+               Set_Comes_From_Source
+                 (New_Node, Default_Node.Comes_From_Source);
             end if;
 
-            --  If the node is call and has named associations,
-            --  set the corresponding links in the copy.
+            --  If the node is a call and has named associations, set the
+            --  corresponding links in the copy.
 
-            if (Nkind (Old_Node) = N_Function_Call
-                 or else Nkind (Old_Node) = N_Entry_Call_Statement
-                 or else
-                   Nkind (Old_Node) = N_Procedure_Call_Statement)
+            if Nkind_In (Old_Node, N_Entry_Call_Statement,
+                                   N_Function_Call,
+                                   N_Procedure_Call_Statement)
               and then Present (First_Named_Actual (Old_Node))
             then
                Adjust_Named_Associations (Old_Node, New_Node);