diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0bce664d3d25..9d5222b95ce5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2015-05-27 Ed Schonberg + + * 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 + + * 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 + + * 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 + + * sem_aux.adb, sem_aux.ads (First_Discriminant): Return empty when + applied to a type with no known discriminants. + 2015-05-26 Robert Dewar * 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 ca6971e05308..7156c76a8ef2 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 31644b076e36..32d5b1f299cd 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 5268b011a3a6..db0931e07135 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 43cbffce8be4..18a9b0299ee8 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 07517bbc4676..01fd0cd969e0 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> + Output_Calls (N, Check_Elab_Flag => False); end if; end if;