From 66371f94f55df849da15ffa9334868de99ac1f8c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 27 May 2015 15:21:36 +0200 Subject: [PATCH] [multiple changes] 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. From-SVN: r223752 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/exp_ch5.adb | 11 +++++++++-- gcc/ada/sem_aux.adb | 7 ++++++- gcc/ada/sem_aux.ads | 6 +++--- gcc/ada/sem_ch6.adb | 8 ++++++-- gcc/ada/sem_elab.adb | 26 ++++++++++++++++++++++++++ 6 files changed, 77 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0bce664d3d2..9d5222b95ce 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 ca6971e0530..7156c76a8ef 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 31644b076e3..32d5b1f299c 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 5268b011a3a..db0931e0713 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 43cbffce8be..18a9b0299ee 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 07517bbc467..01fd0cd969e 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; -- 2.30.2