[multiple changes]

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Process_Formals): A non-private formal type that
	is a limited view does not have a list of private dependents.

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Case_Statement): If the expression in
	the case statement is a compile-time known value, we look for a
	corresponding alternative to optimize the case statement into a
	single case. If the type has a static predicate and the expression
	does not satisfy the predicate, there is no legal alternative and
	this optimization is not applicable.  Excecution is erroneous,
	or else if assertions are enabled, an exception will be raised
	earlier, at the point the expression is elaborated.

2015-05-27  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Check_Internal_Call_Continue): Suppress
	warning on Finalize, Adjust, or Initialize if type involved has
	Warnings_Off set.

2015-05-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb, sem_aux.ads (First_Discriminant): Return empty when
	applied to a type with no known discriminants.

From-SVN: r223752

6 files changed, 77 insertions, 8 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0bce664..9d5222b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2015-05-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Process_Formals): A non-private formal type that
+	is a limited view does not have a list of private dependents.
+
+2015-05-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Case_Statement): If the expression in
+	the case statement is a compile-time known value, we look for a
+	corresponding alternative to optimize the case statement into a
+	single case. If the type has a static predicate and the expression
+	does not satisfy the predicate, there is no legal alternative and
+	this optimization is not applicable.  Excecution is erroneous,
+	or else if assertions are enabled, an exception will be raised
+	earlier, at the point the expression is elaborated.
+
+2015-05-27  Robert Dewar  <dewar@adacore.com>
+
+	* sem_elab.adb (Check_Internal_Call_Continue): Suppress
+	warning on Finalize, Adjust, or Initialize if type involved has
+	Warnings_Off set.
+
+2015-05-27  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aux.adb, sem_aux.ads (First_Discriminant): Return empty when
+	applied to a type with no known discriminants.
+
 2015-05-26  Robert Dewar  <dewar@adacore.com>
 
 	* errout.ads, sem_ch4.adb, sem_ch6.adb: Minor reformatting.
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index ca6971e..7156c76 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2586,9 +2586,16 @@ package body Exp_Ch5 is
 
    begin
       --  Check for the situation where we know at compile time which branch
-      --  will be taken
+      --  will be taken.
 
-      if Compile_Time_Known_Value (Expr) then
+      --  If the value is static but its subtype is predicated and the value
+      --  does not obey the predicate, the value is marked non-static, and
+      --  there can be no corresponding static alternative.
+
+      if Compile_Time_Known_Value (Expr)
+        and then (not Has_Predicates (Etype (Expr))
+                   or else Is_Static_Expression (Expr))
+      then
          Alt := Find_Static_Alternative (N);
 
          --  Do not consider controlled objects found in a case statement which
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 31644b0..32d5b1f 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -246,7 +246,12 @@ package body Sem_Aux is
          Ent := Next_Entity (Ent);
       end loop;
 
-      pragma Assert (Ekind (Ent) = E_Discriminant);
+      --  Call may be on a private type with unknown discriminants, in which
+      --  case Ent is Empty, and as per the spec, we return Empty in this case.
+
+      --  Historical note: The revious assertion that Ent is a discriminant
+      --  was overly cautious and prevented application of this function in
+      --  SPARK applications.
 
       return Ent;
    end First_Discriminant;
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index 5268b01..db0931e 100644
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -119,9 +119,9 @@ package Sem_Aux is
    --  First_Entity. The exception arises for tagged types, where the tag
    --  itself is prepended to the front of the entity chain, so the
    --  First_Discriminant function steps past the tag if it is present.
-   --  The caller is responsible for checking that the type has discriminants,
-   --  so for example it is improper to call this function on a private
-   --  type with unknown discriminants.
+   --  The caller is responsible for checking that the type has discriminants.
+   --  When called on a private type with unknown discriminants, the function
+   --  always returns Empty.
 
    function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id;
    --  Typ is a type with discriminants. Gives the first discriminant stored
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 43cbffc..18a9b02 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -10117,9 +10117,13 @@ package body Sem_Ch6 is
                        (Parent (T), N_Access_Function_Definition,
                                     N_Access_Procedure_Definition)
                      then
-                        if not Is_Class_Wide_Type (Formal_Type) then
+                        --  A limited view has no private dependents
+
+                        if not Is_Class_Wide_Type (Formal_Type)
+                          and then not From_Limited_With (Formal_Type)
+                        then
                            Append_Elmt (Current_Scope,
-                               Private_Dependents (Base_Type (Formal_Type)));
+                             Private_Dependents (Base_Type (Formal_Type)));
                         end if;
 
                         --  Freezing is delayed to ensure that Register_Prim
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 07517bb..01fd0cd 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -2447,6 +2447,30 @@ package body Sem_Elab is
                  ("instantiation of& may occur before body is seen<l<",
                   N, Orig_Ent);
             else
+               --  A rather specific check. For Finalize/Adjust/Initialize,
+               --  if the type has Warnings_Off set, suppress the warning.
+
+               if Nam_In (Chars (E), Name_Adjust,
+                                     Name_Finalize,
+                                     Name_Initialize)
+                 and then Present (First_Formal (E))
+               then
+                  declare
+                     T : constant Entity_Id := Etype (First_Formal (E));
+                  begin
+                     if Is_Controlled (T) then
+                        if Warnings_Off (T)
+                          or else (Ekind (T) = E_Private_Type
+                                    and then Warnings_Off (Full_View (T)))
+                        then
+                           goto Output;
+                        end if;
+                     end if;
+                  end;
+               end if;
+
+               --  Go ahead and give warning if not this special case
+
                Error_Msg_NE
                  ("call to& may occur before body is seen<l<", N, Orig_Ent);
             end if;
@@ -2458,6 +2482,8 @@ package body Sem_Elab is
             --  all the clarification messages produces by Output_Calls must be
             --  emitted unconditionally.
 
+            <<Output>>
+
             Output_Calls (N, Check_Elab_Flag => False);
          end if;
       end if;