Commit b2c1aa8f by Arnaud Charlet

[multiple changes]

2017-01-13  Ed Schonberg  <schonberg@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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
parent 72cdccfa
2017-01-13 Ed Schonberg <schonberg@adacore.com>
* 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 <kirtchev@adacore.com>
* 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 <kirtchev@adacore.com> 2017-01-13 Hristian Kirtchev <kirtchev@adacore.com>
* sem_aggr.adb, sem_ch3.adb, inline.adb, sem_util.adb, exp_ch4.adb, * sem_aggr.adb, sem_ch3.adb, inline.adb, sem_util.adb, exp_ch4.adb,
......
...@@ -4272,7 +4272,7 @@ package body Exp_Aggr is ...@@ -4272,7 +4272,7 @@ package body Exp_Aggr is
-- values, and can be passed as is to the back-end without further -- values, and can be passed as is to the back-end without further
-- expansion. -- expansion.
-- An Iterated_component_Association is treated as non-static, but there -- An Iterated_component_Association is treated as non-static, but there
-- are posibilities for optimization here. -- are possibilities for optimization here.
function Flatten function Flatten
(N : Node_Id; (N : Node_Id;
...@@ -4945,6 +4945,13 @@ package body Exp_Aggr is ...@@ -4945,6 +4945,13 @@ package body Exp_Aggr is
end if; end if;
end loop; 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 if not Is_Discrete_Type (Ctyp) then
return False; return False;
end if; end if;
......
...@@ -7106,8 +7106,10 @@ package body Exp_Ch3 is ...@@ -7106,8 +7106,10 @@ package body Exp_Ch3 is
-- Local variables -- Local variables
Def_Id : constant Entity_Id := Entity (N); 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 -- Start of processing for Freeze_Type
...@@ -7117,6 +7119,7 @@ package body Exp_Ch3 is ...@@ -7117,6 +7119,7 @@ package body Exp_Ch3 is
-- marked as Ghost. -- marked as Ghost.
Set_Ghost_Mode (Def_Id, Mode); Set_Ghost_Mode (Def_Id, Mode);
Mode_Set := True;
-- Process any remote access-to-class-wide types designating the type -- Process any remote access-to-class-wide types designating the type
-- being frozen. -- being frozen.
...@@ -7444,12 +7447,18 @@ package body Exp_Ch3 is ...@@ -7444,12 +7447,18 @@ package body Exp_Ch3 is
Build_Invariant_Procedure_Body (Def_Id); Build_Invariant_Procedure_Body (Def_Id);
end if; end if;
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
return Result; return Result;
exception exception
when RE_Not_Available => when RE_Not_Available =>
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
return False; return False;
end Freeze_Type; end Freeze_Type;
......
...@@ -1656,19 +1656,18 @@ package body Sem_Aggr is ...@@ -1656,19 +1656,18 @@ package body Sem_Aggr is
while Present (Choice) loop while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then if Nkind (Choice) = N_Others_Choice then
Error_Msg_N ("others choice not allowed in this context", N);
Others_Present := True; Others_Present := True;
else else
Analyze_And_Resolve (Choice, Index_Typ); Analyze_And_Resolve (Choice, Index_Typ);
end if; end if;
Nb_Choices := Nb_Choices + 1;
Next (Choice); Next (Choice);
end loop; end loop;
-- Create a scope in which to introduce an index, which is usually -- 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'); Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L');
Set_Etype (Ent, Standard_Void_Type); Set_Etype (Ent, Standard_Void_Type);
...@@ -1730,16 +1729,15 @@ package body Sem_Aggr is ...@@ -1730,16 +1729,15 @@ package body Sem_Aggr is
while Present (Assoc) loop while Present (Assoc) loop
if Nkind (Assoc) = N_Iterated_Component_Association then if Nkind (Assoc) = N_Iterated_Component_Association then
Resolve_Iterated_Component_Association (Assoc, Index_Typ); Resolve_Iterated_Component_Association (Assoc, Index_Typ);
goto Next_Assoc;
end if; end if;
Choice := First (Choices (Assoc)); Choice := First (Choice_List (Assoc));
Delete_Choice := False; Delete_Choice := False;
while Present (Choice) loop while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then if Nkind (Choice) = N_Others_Choice then
Others_Present := True; Others_Present := True;
if Choice /= First (Choices (Assoc)) if Choice /= First (Choice_List (Assoc))
or else Present (Next (Choice)) or else Present (Next (Choice))
then then
Error_Msg_N Error_Msg_N
...@@ -1829,7 +1827,6 @@ package body Sem_Aggr is ...@@ -1829,7 +1827,6 @@ package body Sem_Aggr is
end; end;
end loop; end loop;
<<Next_Assoc>>
Next (Assoc); Next (Assoc);
end loop; end loop;
end if; end if;
......
...@@ -3668,7 +3668,8 @@ package body Sem_Ch12 is ...@@ -3668,7 +3668,8 @@ package body Sem_Ch12 is
-- Local declarations -- Local declarations
Mode : Ghost_Mode_Type; Mode : Ghost_Mode_Type;
Mode_Set : Boolean := False;
Vis_Prims_List : Elist_Id := No_Elist; Vis_Prims_List : Elist_Id := No_Elist;
-- List of primitives made temporarily visible in the instantiation -- List of primitives made temporarily visible in the instantiation
...@@ -3746,6 +3747,7 @@ package body Sem_Ch12 is ...@@ -3746,6 +3747,7 @@ package body Sem_Ch12 is
-- Ghost. -- Ghost.
Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode); Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode);
Mode_Set := True;
-- Verify that it is the name of a generic package -- Verify that it is the name of a generic package
...@@ -4438,7 +4440,9 @@ package body Sem_Ch12 is ...@@ -4438,7 +4440,9 @@ package body Sem_Ch12 is
Analyze_Aspect_Specifications (N, Act_Decl_Id); Analyze_Aspect_Specifications (N, Act_Decl_Id);
end if; end if;
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
exception exception
when Instantiation_Error => when Instantiation_Error =>
...@@ -4455,7 +4459,9 @@ package body Sem_Ch12 is ...@@ -4455,7 +4459,9 @@ package body Sem_Ch12 is
SPARK_Mode_Pragma := Save_SMP; SPARK_Mode_Pragma := Save_SMP;
Style_Check := Save_Style_Check; Style_Check := Save_Style_Check;
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
end Analyze_Package_Instantiation; end Analyze_Package_Instantiation;
-------------------------- --------------------------
...@@ -5093,8 +5099,6 @@ package body Sem_Ch12 is ...@@ -5093,8 +5099,6 @@ package body Sem_Ch12 is
-- Local variables -- Local variables
Mode : Ghost_Mode_Type;
Save_IPSM : constant Boolean := Ignore_Pragma_SPARK_Mode; Save_IPSM : constant Boolean := Ignore_Pragma_SPARK_Mode;
-- Save flag Ignore_Pragma_SPARK_Mode for restore on exit -- Save flag Ignore_Pragma_SPARK_Mode for restore on exit
...@@ -5102,6 +5106,9 @@ package body Sem_Ch12 is ...@@ -5102,6 +5106,9 @@ package body Sem_Ch12 is
Save_SMP : constant Node_Id := SPARK_Mode_Pragma; Save_SMP : constant Node_Id := SPARK_Mode_Pragma;
-- Save the SPARK_Mode-related data for restore on exit -- 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; Vis_Prims_List : Elist_Id := No_Elist;
-- List of primitives made temporarily visible in the instantiation -- List of primitives made temporarily visible in the instantiation
-- to match the visibility of the formal type -- to match the visibility of the formal type
...@@ -5143,6 +5150,7 @@ package body Sem_Ch12 is ...@@ -5143,6 +5150,7 @@ package body Sem_Ch12 is
-- Ghost. -- Ghost.
Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode); Mark_And_Set_Ghost_Instantiation (N, Gen_Unit, Mode);
Mode_Set := True;
Generate_Reference (Gen_Unit, Gen_Id); Generate_Reference (Gen_Unit, Gen_Id);
...@@ -5404,7 +5412,9 @@ package body Sem_Ch12 is ...@@ -5404,7 +5412,9 @@ package body Sem_Ch12 is
Analyze_Aspect_Specifications (N, Act_Decl_Id); Analyze_Aspect_Specifications (N, Act_Decl_Id);
end if; end if;
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
exception exception
when Instantiation_Error => when Instantiation_Error =>
...@@ -5420,7 +5430,9 @@ package body Sem_Ch12 is ...@@ -5420,7 +5430,9 @@ package body Sem_Ch12 is
SPARK_Mode := Save_SM; SPARK_Mode := Save_SM;
SPARK_Mode_Pragma := Save_SMP; SPARK_Mode_Pragma := Save_SMP;
Restore_Ghost_Mode (Mode); if Mode_Set then
Restore_Ghost_Mode (Mode);
end if;
end Analyze_Subprogram_Instantiation; end Analyze_Subprogram_Instantiation;
------------------------- -------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment