From 102743865182358d96fafb28dcd58aa4ecb1c055 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 7 Nov 2014 14:54:09 +0100 Subject: [PATCH] [multiple changes] 2014-11-07 Hristian Kirtchev * einfo.adb (Set_Is_Checked_Ghost_Entity, Set_Is_Ignored_Ghost_Entity): Add exceptions to the assertion check. * sem_ch6.adb (Check_Conformance): Consider only source subprograms when checking for Ghost conformance. * sem_prag.adb (Analyze_Pragma): Handle the case where pragma Ghost applies to a stand alone subprogram body that acts as a compilation unit. * sem_res.adb: Minor reformatting (merge if statements). 2014-11-07 Ed Schonberg * exp_strm.adb (Build_Record_Or_Elementary_Input_Function): Check whether underlying type is constrained before generating the object declaration for the result object of the function. From-SVN: r217226 --- gcc/ada/ChangeLog | 18 +++++++++++++++++ gcc/ada/einfo.adb | 2 ++ gcc/ada/exp_strm.adb | 6 ++++++ gcc/ada/sem_ch6.adb | 9 +++++++-- gcc/ada/sem_prag.adb | 10 +++++++++- gcc/ada/sem_res.adb | 55 ++++++++++++++++++++++++---------------------------- 6 files changed, 67 insertions(+), 33 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ed69701..99ba43c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2014-11-07 Hristian Kirtchev + + * einfo.adb (Set_Is_Checked_Ghost_Entity, + Set_Is_Ignored_Ghost_Entity): Add exceptions to the assertion + check. + * sem_ch6.adb (Check_Conformance): Consider only + source subprograms when checking for Ghost conformance. + * sem_prag.adb (Analyze_Pragma): Handle the case + where pragma Ghost applies to a stand alone subprogram body that + acts as a compilation unit. + * sem_res.adb: Minor reformatting (merge if statements). + +2014-11-07 Ed Schonberg + + * exp_strm.adb (Build_Record_Or_Elementary_Input_Function): + Check whether underlying type is constrained before generating + the object declaration for the result object of the function. + 2014-11-07 Robert Dewar * freeze.adb: Code clean up. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 53ba3db..f9307ab 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -4748,6 +4748,7 @@ package body Einfo is or else Ekind (Id) = E_Abstract_State or else Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant + or else Ekind (Id) = E_Exception or else Ekind (Id) = E_Package_Body or else Ekind (Id) = E_Subprogram_Body); Set_Flag277 (Id, V); @@ -4942,6 +4943,7 @@ package body Einfo is or else Ekind (Id) = E_Abstract_State or else Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant + or else Ekind (Id) = E_Exception or else Ekind (Id) = E_Package_Body or else Ekind (Id) = E_Subprogram_Body); Set_Flag278 (Id, V); diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index dfb5f0d..da16134 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -1123,9 +1123,15 @@ package body Exp_Strm is J := 1; + -- In the presence of multiple instantiations (as in uses of the Booch + -- components) the base type may be private, and the underlying type + -- already constrained, in which case there's no discriminant constraint + -- to construct. + if Has_Discriminants (Typ) and then No (Discriminant_Default_Value (First_Discriminant (Typ))) + and then not Is_Constrained (Underlying_Type (B_Typ)) then Discr := First_Discriminant (B_Typ); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8536aa6..8219728 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4766,9 +4766,14 @@ package body Sem_Ch6 is return; -- Pragma Ghost behaves as a convention in the context of subtype - -- conformance (SPARK RM 6.9(5)). + -- conformance (SPARK RM 6.9(5)). Do not check internally generated + -- subprograms as their spec may reside in a Ghost region and their + -- body not, or vice versa. - elsif Is_Ghost_Entity (Old_Id) /= Is_Ghost_Entity (New_Id) then + elsif Comes_From_Source (Old_Id) + and then Comes_From_Source (New_Id) + and then Is_Ghost_Entity (Old_Id) /= Is_Ghost_Entity (New_Id) + then Conformance_Error ("\ghost modes do not match!"); return; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e5c3d85..0276b5e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14216,7 +14216,7 @@ package body Sem_Prag is -- pragma Ghost [ (boolean_EXPRESSION) ]; when Pragma_Ghost => Ghost : declare - Context : constant Node_Id := Parent (N); + Context : Node_Id; Expr : Node_Id; Id : Entity_Id; Orig_Stmt : Node_Id; @@ -14228,6 +14228,14 @@ package body Sem_Prag is Check_No_Identifiers; Check_At_Most_N_Arguments (1); + Context := Parent (N); + + -- Handle compilation units + + if Nkind (Context) = N_Compilation_Unit_Aux then + Context := Unit (Parent (Context)); + end if; + Id := Empty; Stmt := Prev (N); while Present (Stmt) loop diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0b295f9..addc32c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7053,42 +7053,37 @@ package body Sem_Res is end if; -- The following checks are only relevant when SPARK_Mode is on as they - -- are not standard Ada legality rules. + -- are not standard Ada legality rules. An effectively volatile object + -- subject to enabled properties Async_Writers or Effective_Reads must + -- appear in a specific context. - if SPARK_Mode = On then - - -- An effectively volatile object subject to enabled properties - -- Async_Writers or Effective_Reads must appear in a specific - -- context. - - if Is_Object (E) - and then Is_Effectively_Volatile (E) - and then - (Async_Writers_Enabled (E) or else Effective_Reads_Enabled (E)) - and then Comes_From_Source (N) - then - -- The effectively volatile objects appears in a "non-interfering - -- context" as defined in SPARK RM 7.1.3(13). + if SPARK_Mode = On + and then Is_Object (E) + and then Is_Effectively_Volatile (E) + and then + (Async_Writers_Enabled (E) or else Effective_Reads_Enabled (E)) + and then Comes_From_Source (N) + then + -- The effectively volatile objects appears in a "non-interfering + -- context" as defined in SPARK RM 7.1.3(13). - if Is_OK_Volatile_Context (Par, N) then - null; + if Is_OK_Volatile_Context (Par, N) then + null; - -- Assume that references to effectively volatile objects that - -- appear as actual parameters in a procedure call are always - -- legal. A full legality check is done when the actuals are - -- resolved. + -- Assume that references to effectively volatile objects that appear + -- as actual parameters in a procedure call are always legal. A full + -- legality check is done when the actuals are resolved. - elsif Nkind (Par) = N_Procedure_Call_Statement then - null; + elsif Nkind (Par) = N_Procedure_Call_Statement then + null; - -- Otherwise the context causes a side effect with respect to the - -- effectively volatile object. + -- Otherwise the context causes a side effect with respect to the + -- effectively volatile object. - else - SPARK_Msg_N - ("volatile object cannot appear in this context " - & "(SPARK RM 7.1.3(13))", N); - end if; + else + SPARK_Msg_N + ("volatile object cannot appear in this context " + & "(SPARK RM 7.1.3(13))", N); end if; end if; -- 2.7.4