From b2c1aa8fe9463fcfe5f1750023bff9093f5b3b41 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Jan 2017 11:48:57 +0100 Subject: [PATCH] [multiple changes] 2017-01-13 Ed Schonberg * sem_aggr.adb (Resolve_Array_Aggregate): The code that verifies the legality of An others clause applies as well to a choice in an Iterated_component_ association. (Resolve_Iterated_Component_Association): An others choice is legal. * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): An Iterated_Component_Association is not static. 2017-01-13 Hristian Kirtchev * exp_ch3.adb (Freeze_Type): Mark the Ghost mode as set in case control is passed to the expresion handler before the new mode is set. * sem_ch12.adb (Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation): Mark the Ghost mode as set in case control is passed to the expresion handler before the new mode is set. From-SVN: r244417 --- gcc/ada/ChangeLog | 20 ++++++++++++++++++++ gcc/ada/exp_aggr.adb | 9 ++++++++- gcc/ada/exp_ch3.adb | 17 +++++++++++++---- gcc/ada/sem_aggr.adb | 11 ++++------- gcc/ada/sem_ch12.adb | 26 +++++++++++++++++++------- 5 files changed, 64 insertions(+), 19 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index be22acb7fd0..92122528318 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-01-13 Ed Schonberg + + * sem_aggr.adb (Resolve_Array_Aggregate): The code that verifies + the legality of An others clause applies as well to a choice in + an Iterated_component_ association. + (Resolve_Iterated_Component_Association): An others choice + is legal. + * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): An + Iterated_Component_Association is not static. + +2017-01-13 Hristian Kirtchev + + * exp_ch3.adb (Freeze_Type): Mark the Ghost mode as set in case + control is passed to the expresion handler before the new mode + is set. + * sem_ch12.adb (Analyze_Package_Instantiation, + Analyze_Subprogram_Instantiation): Mark the Ghost mode as set + in case control is passed to the expresion handler before the + new mode is set. + 2017-01-13 Hristian Kirtchev * sem_aggr.adb, sem_ch3.adb, inline.adb, sem_util.adb, exp_ch4.adb, diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 4f072f7eab9..2b750bf807d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4272,7 +4272,7 @@ package body Exp_Aggr is -- values, and can be passed as is to the back-end without further -- expansion. -- An Iterated_component_Association is treated as non-static, but there - -- are posibilities for optimization here. + -- are possibilities for optimization here. function Flatten (N : Node_Id; @@ -4945,6 +4945,13 @@ package body Exp_Aggr is end if; end loop; + -- An Iterated_Component_Association involves a loop (in most cases) + -- and is never static. + + if Nkind (Parent (Expr)) = N_Iterated_Component_Association then + return False; + end if; + if not Is_Discrete_Type (Ctyp) then return False; end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index e6879a3c358..5084714affb 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7106,8 +7106,10 @@ package body Exp_Ch3 is -- Local variables Def_Id : constant Entity_Id := Entity (N); - Mode : Ghost_Mode_Type; - Result : Boolean := False; + + Mode : Ghost_Mode_Type; + Mode_Set : Boolean := False; + Result : Boolean := False; -- Start of processing for Freeze_Type @@ -7117,6 +7119,7 @@ package body Exp_Ch3 is -- marked as Ghost. Set_Ghost_Mode (Def_Id, Mode); + Mode_Set := True; -- Process any remote access-to-class-wide types designating the type -- being frozen. @@ -7444,12 +7447,18 @@ package body Exp_Ch3 is Build_Invariant_Procedure_Body (Def_Id); end if; - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; + return Result; exception when RE_Not_Available => - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; + return False; end Freeze_Type; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d86dc355a1e..92b9da6f303 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1656,19 +1656,18 @@ package body Sem_Aggr is while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then - Error_Msg_N ("others choice not allowed in this context", N); Others_Present := True; else Analyze_And_Resolve (Choice, Index_Typ); end if; - Nb_Choices := Nb_Choices + 1; Next (Choice); end loop; -- Create a scope in which to introduce an index, which is usually - -- visible in the expression for the component. + -- visible in the expression for the component, and needed for its + -- analysis. Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Set_Etype (Ent, Standard_Void_Type); @@ -1730,16 +1729,15 @@ package body Sem_Aggr is while Present (Assoc) loop if Nkind (Assoc) = N_Iterated_Component_Association then Resolve_Iterated_Component_Association (Assoc, Index_Typ); - goto Next_Assoc; end if; - Choice := First (Choices (Assoc)); + Choice := First (Choice_List (Assoc)); Delete_Choice := False; while Present (Choice) loop if Nkind (Choice) = N_Others_Choice then Others_Present := True; - if Choice /= First (Choices (Assoc)) + if Choice /= First (Choice_List (Assoc)) or else Present (Next (Choice)) then Error_Msg_N @@ -1829,7 +1827,6 @@ package body Sem_Aggr is end; end loop; - <> Next (Assoc); end loop; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 89c008092f8..fadb831bb47 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3668,7 +3668,8 @@ package body Sem_Ch12 is -- Local declarations - Mode : Ghost_Mode_Type; + Mode : Ghost_Mode_Type; + Mode_Set : Boolean := False; Vis_Prims_List : Elist_Id := No_Elist; -- List of primitives made temporarily visible in the instantiation @@ -3746,6 +3747,7 @@ package body Sem_Ch12 is -- Ghost. Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode); + Mode_Set := True; -- Verify that it is the name of a generic package @@ -4438,7 +4440,9 @@ package body Sem_Ch12 is Analyze_Aspect_Specifications (N, Act_Decl_Id); end if; - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; exception when Instantiation_Error => @@ -4455,7 +4459,9 @@ package body Sem_Ch12 is SPARK_Mode_Pragma := Save_SMP; Style_Check := Save_Style_Check; - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; end Analyze_Package_Instantiation; -------------------------- @@ -5093,8 +5099,6 @@ package body Sem_Ch12 is -- Local variables - Mode : Ghost_Mode_Type; - Save_IPSM : constant Boolean := Ignore_Pragma_SPARK_Mode; -- Save flag Ignore_Pragma_SPARK_Mode for restore on exit @@ -5102,6 +5106,9 @@ package body Sem_Ch12 is Save_SMP : constant Node_Id := SPARK_Mode_Pragma; -- Save the SPARK_Mode-related data for restore on exit + Mode : Ghost_Mode_Type; + Mode_Set : Boolean := False; + Vis_Prims_List : Elist_Id := No_Elist; -- List of primitives made temporarily visible in the instantiation -- to match the visibility of the formal type @@ -5143,6 +5150,7 @@ package body Sem_Ch12 is -- Ghost. Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode); + Mode_Set := True; Generate_Reference (Gen_Unit, Gen_Id); @@ -5404,7 +5412,9 @@ package body Sem_Ch12 is Analyze_Aspect_Specifications (N, Act_Decl_Id); end if; - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; exception when Instantiation_Error => @@ -5420,7 +5430,9 @@ package body Sem_Ch12 is SPARK_Mode := Save_SM; SPARK_Mode_Pragma := Save_SMP; - Restore_Ghost_Mode (Mode); + if Mode_Set then + Restore_Ghost_Mode (Mode); + end if; end Analyze_Subprogram_Instantiation; ------------------------- -- 2.30.2