From 93e90bf474fd9410af5127417d542c2f80466ca4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 11:04:48 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Gary Dismukes * par_sco.adb, sem_util.adb, sem_ch13.adb: Minor typo corrections and reformatting. 2016-04-20 Ed Schonberg * sem_prag.adb (Analyze_Pragma, case Default_Storage_Pool): If the pragma comes from an aspect specification, verify that the aspect applies to an entity with a declarative part. * exp_ch5.adb: Code cleanup. 2016-04-20 Ed Schonberg * sem_res.adb (Resolve_If_Expression): If first expression is universal, resolve subsequent ones with the corresponding class type (Any_Integer or Any_Real). 2016-04-20 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification): If expansion is disabled, complete the analysis of the iterator name to ensure that reference for entities within are properly generated. 2016-04-20 Arnaud Charlet * a-dispat.ads (Yield): add Global contract. * a-calend.ads, a-reatim.ads: Added Initializes => Clock_Time. * a-taside.adb: Added Initializes => Tasking_State. From-SVN: r235240 --- gcc/ada/ChangeLog | 30 ++++++++++++++++++++++++++++++ gcc/ada/a-calend.ads | 3 ++- gcc/ada/a-dispat.ads | 3 ++- gcc/ada/a-reatim.ads | 3 ++- gcc/ada/a-taside.ads | 3 ++- gcc/ada/exp_ch5.adb | 2 +- gcc/ada/par_sco.adb | 4 ++-- gcc/ada/sem_ch13.adb | 6 +++--- gcc/ada/sem_ch5.adb | 15 +++++++++------ gcc/ada/sem_prag.adb | 11 +++++++++++ gcc/ada/sem_res.adb | 12 +++++++++++- gcc/ada/sem_util.adb | 4 ++-- 12 files changed, 77 insertions(+), 19 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 93e1eeb7f74..75201ec493e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2016-04-20 Gary Dismukes + + * par_sco.adb, sem_util.adb, sem_ch13.adb: Minor typo corrections and + reformatting. + +2016-04-20 Ed Schonberg + + * sem_prag.adb (Analyze_Pragma, case Default_Storage_Pool): + If the pragma comes from an aspect specification, verify that + the aspect applies to an entity with a declarative part. + * exp_ch5.adb: Code cleanup. + +2016-04-20 Ed Schonberg + + * sem_res.adb (Resolve_If_Expression): If first expression is + universal, resolve subsequent ones with the corresponding class + type (Any_Integer or Any_Real). + +2016-04-20 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specification): If expansion is + disabled, complete the analysis of the iterator name to ensure + that reference for entities within are properly generated. + +2016-04-20 Arnaud Charlet + + * a-dispat.ads (Yield): add Global contract. + * a-calend.ads, a-reatim.ads: Added Initializes => Clock_Time. + * a-taside.adb: Added Initializes => Tasking_State. + 2016-04-20 Hristian Kirtchev * sem_ch13.adb (Build_Invariant_Procedure): diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads index d7651037c79..39e9c33c13f 100644 --- a/gcc/ada/a-calend.ads +++ b/gcc/ada/a-calend.ads @@ -37,7 +37,8 @@ package Ada.Calendar with SPARK_Mode, Abstract_State => (Clock_Time with Synchronous, External => (Async_Readers, - Async_Writers)) + Async_Writers)), + Initializes => Clock_Time is type Time is private; diff --git a/gcc/ada/a-dispat.ads b/gcc/ada/a-dispat.ads index a1939409d14..b4e4d036b11 100644 --- a/gcc/ada/a-dispat.ads +++ b/gcc/ada/a-dispat.ads @@ -16,7 +16,8 @@ package Ada.Dispatching is pragma Preelaborate (Dispatching); - procedure Yield; + procedure Yield with + Global => null; Dispatching_Policy_Error : exception; end Ada.Dispatching; diff --git a/gcc/ada/a-reatim.ads b/gcc/ada/a-reatim.ads index 8b341c0b58d..cb84859df63 100644 --- a/gcc/ada/a-reatim.ads +++ b/gcc/ada/a-reatim.ads @@ -40,7 +40,8 @@ package Ada.Real_Time with SPARK_Mode, Abstract_State => (Clock_Time with Synchronous, External => (Async_Readers, - Async_Writers)) + Async_Writers)), + Initializes => Clock_Time is pragma Compile_Time_Error diff --git a/gcc/ada/a-taside.ads b/gcc/ada/a-taside.ads index ee39ec3e5a9..72467bf66d3 100644 --- a/gcc/ada/a-taside.ads +++ b/gcc/ada/a-taside.ads @@ -40,7 +40,8 @@ package Ada.Task_Identification with SPARK_Mode, Abstract_State => (Tasking_State with Synchronous, External => (Async_Readers, - Async_Writers)) + Async_Writers)), + Initializes => Tasking_State is pragma Preelaborate; -- In accordance with Ada 2005 AI-362 diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 25a9fe0df24..d7a0d9ed6f2 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1696,7 +1696,7 @@ package body Exp_Ch5 is -- subprogram. In restricted profiles this is not available. if Nkind (Ent) = N_Function_Call - and then RTE_Available (RE_Get_Ceiling) + and then not Configurable_Run_Time_Mode and then (Entity (Name (Ent)) = RTE (RE_Get_Ceiling) or else Entity (Name (Ent)) = RTE (RO_PE_Get_Ceiling)) diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 1aa4bc9baeb..d10e1d2ae6d 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -2797,7 +2797,7 @@ package body Par_SCO is when others => if T.C2 = '?' then - -- This in not a logical operator: start looking for + -- This is not a logical operator: start looking for -- nested decisions from here. Recurse over the left -- child and let the loop take care of the right one. @@ -2849,7 +2849,7 @@ package body Par_SCO is when others => if T.C2 = '?' and then Process_Nested_Decisions then - -- This in not a logical operator: start looking for + -- This is not a logical operator: start looking for -- nested decisions from here. Recurse over the left -- child and let the loop take care of the right one. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5fc8304de28..aa929bd4428 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8336,7 +8336,7 @@ package body Sem_Ch13 is Statements => Stmts)); -- The processing of an invariant pragma immediately generates the - -- invariant procedure spec, inserts it into the tree and analyzes + -- invariant procedure spec, inserts it into the tree, and analyzes -- it. If the spec has not been analyzed, then the invariant pragma -- is being inherited and requires manual insertion and analysis. @@ -8362,9 +8362,9 @@ package body Sem_Ch13 is end if; -- Otherwise there are no private declarations. This is either an - -- error or the related type is a private extension in which case + -- error or the related type is a private extension, in which case -- it does not need a completion in a private part. Insert the body - -- and the end of the visible declarations and analyze immediately + -- at the end of the visible declarations and analyze immediately -- because the related type is about to be frozen. else diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 657a0e45dfa..64b05ff9502 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1925,11 +1925,12 @@ package body Sem_Ch5 is -- Do not perform this expansion in SPARK mode, since the formal -- verification directly deals with the source form of the iterator. - -- Ditto for ASIS, where the temporary may hide the transformation - -- of a selected component into a prefixed function call. + -- Ditto for ASIS and when expansion is disabled,, where the temporary + -- may hide the transformation of a selected component into a prefixed + -- function call, and references need to see the original expression. and then not GNATprove_Mode - and then not ASIS_Mode + and then Expander_Active then declare Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name); @@ -2016,7 +2017,7 @@ package body Sem_Ch5 is -- Iterate is not a reserved name. What matters is that the return type -- of the function is an iterator type. - elsif Is_Entity_Name (Iter_Name) then + elsif Is_Entity_Name (Iter_Name) or else not Expander_Active then Analyze (Iter_Name); if Nkind (Iter_Name) = N_Function_Call then @@ -2266,9 +2267,11 @@ package body Sem_Ch5 is -- If that object is a selected component, verify that it is not -- a component of an unconstrained mutable object. - if Nkind (Iter_Name) = N_Identifier then + if Nkind (Iter_Name) = N_Identifier + or else (not Expander_Active and Comes_From_Source (Iter_Name)) + then declare - Orig_Node : constant Node_Id := Original_Node (Iter_Name); + Orig_Node : constant Node_Id := Original_Node (Iter_Name); Iter_Kind : constant Node_Kind := Nkind (Orig_Node); Obj : Node_Id; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d929c852c94..22daf491148 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13582,6 +13582,17 @@ package body Sem_Prag is Check_Is_In_Decl_Part_Or_Package_Spec; end if; + if From_Aspect_Specification (N) then + declare + E : constant Entity_Id := Entity (Corresponding_Aspect (N)); + begin + if not In_Open_Scopes (E) then + Error_Msg_N + ("aspect must apply to package or subprogram", N); + end if; + end; + end if; + if Present (Arg1) then Pool := Get_Pragma_Arg (Arg1); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 29c56120650..e8495c79eef 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8048,9 +8048,19 @@ package body Sem_Res is end if; -- If ELSE expression present, just resolve using the determined type + -- If type is universal, resolve to any member of the class. if Present (Else_Expr) then - Resolve (Else_Expr, Typ); + if Typ = Universal_Integer then + Resolve (Else_Expr, Any_Integer); + + elsif Typ = Universal_Real then + Resolve (Else_Expr, Any_Real); + + else + Resolve (Else_Expr, Typ); + end if; + Else_Typ := Etype (Else_Expr); if Is_Scalar_Type (Else_Typ) and then Else_Typ /= Typ then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d03eca8c960..e9e16ae4add 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1664,8 +1664,8 @@ package body Sem_Util is -- See if we need elaboration entity. - -- We always need an elaboration entity when preserving control-flow, as - -- we want to remain explicit about the units elaboration order. + -- We always need an elaboration entity when preserving control flow, as + -- we want to remain explicit about the unit's elaboration order. elsif Opt.Suppress_Control_Flow_Optimizations then null; -- 2.30.2