with Einfo; use Einfo;
with Errout; use Errout;
with Expander; use Expander;
+with Exp_Ch6; use Exp_Ch6;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
with Sem_Aux; use Sem_Aux;
with Sem_Case; use Sem_Case;
with Sem_Ch3; use Sem_Ch3;
+with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Disp; use Sem_Disp;
with Sem_Elab; use Sem_Elab;
-----------------------------
procedure Analyze_Block_Statement (N : Node_Id) is
+ procedure Install_Return_Entities (Scop : Entity_Id);
+ -- Install all entities of return statement scope Scop in the visibility
+ -- chain except for the return object since its entity is reused in a
+ -- renaming.
+
+ -----------------------------
+ -- Install_Return_Entities --
+ -----------------------------
+
+ procedure Install_Return_Entities (Scop : Entity_Id) is
+ Id : Entity_Id;
+
+ begin
+ Id := First_Entity (Scop);
+ while Present (Id) loop
+
+ -- Do not install the return object
+
+ if not Ekind_In (Id, E_Constant, E_Variable)
+ or else not Is_Return_Object (Id)
+ then
+ Install_Entity (Id);
+ end if;
+
+ Next_Entity (Id);
+ end loop;
+ end Install_Return_Entities;
+
+ -- Local constants and variables
+
Decls : constant List_Id := Declarations (N);
Id : constant Node_Id := Identifier (N);
HSS : constant Node_Id := Handled_Statement_Sequence (N);
+ Is_BIP_Return_Statement : Boolean;
+
+ -- Start of processing for Analyze_Block_Statement
+
begin
-- In SPARK mode, we reject block statements. Note that the case of
-- block statements generated by the expander is fine.
return;
end if;
+ -- Detect whether the block is actually a rewritten return statement of
+ -- a build-in-place function.
+
+ Is_BIP_Return_Statement :=
+ Present (Id)
+ and then Present (Entity (Id))
+ and then Ekind (Entity (Id)) = E_Return_Statement
+ and then Is_Build_In_Place_Function
+ (Return_Applies_To (Entity (Id)));
+
-- Normal processing with HSS present
declare
Set_Block_Node (Ent, Identifier (N));
Push_Scope (Ent);
+ -- The block served as an extended return statement. Ensure that any
+ -- entities created during the analysis and expansion of the return
+ -- object declaration are once again visible.
+
+ if Is_BIP_Return_Statement then
+ Install_Return_Entities (Ent);
+ end if;
+
if Present (Decls) then
Analyze_Declarations (Decls);
Check_Completion;
Set_Parent (D_Copy, Parent (DS));
Pre_Analyze_Range (D_Copy);
- -- Ada2012: If the domain of iteration is a function call,
+ -- Ada 2012: If the domain of iteration is a function call,
-- it is the new iterator form.
-- We have also implemented the shorter form : for X in S
Typ : Entity_Id;
begin
- -- In semantics mode, introduce loop variable so that loop body can be
- -- properly analyzed. Otherwise this is one after expansion.
+ -- In semantics/Alfa modes, we won't be further expanding the loop, so
+ -- introduce loop variable so that loop body can be properly analyzed.
+ -- Otherwise this happens after expansion.
- if Operating_Mode = Check_Semantics then
+ if Operating_Mode = Check_Semantics
+ or else Alfa_Mode
+ then
Enter_Name (Def_Id);
end if;
if Of_Present (N) then
Set_Etype (Def_Id, Component_Type (Typ));
- elsif Ada_Version < Ada_2012 then
- Error_Msg_N
- ("missing Range attribute in iteration over an array", N);
+ -- Here we have a missing Range attribute
else
Error_Msg_N
- ("to iterate over the elements of an array, use OF", N);
+ ("missing Range attribute in iteration over an array", N);
+
+ -- In Ada 2012 mode, this may be an attempt at an iterator
+
+ if Ada_Version >= Ada_2012 then
+ Error_Msg_NE
+ ("\if& is meant to designate an element of the array, use OF",
+ N, Def_Id);
+ end if;
-- Prevent cascaded errors
Entity (Find_Aspect (Typ, Aspect_Iterator_Element)));
else
+ -- For an iteration of the form IN, the name must denote an
+ -- iterator, typically the result of a call to Iterate. Give a
+ -- useful error message when the name is a container by itself.
+
+ if Is_Entity_Name (Original_Node (Name (N)))
+ and then not Is_Iterator (Typ)
+ then
+ Error_Msg_N
+ ("name must be an iterator, not a container", Name (N));
+
+ Error_Msg_NE
+ ("\to iterate directly over a container, write `of &`",
+ Name (N), Original_Node (Name (N)));
+ end if;
+
-- The result type of Iterate function is the classwide type of
-- the interface parent. We need the specific Cursor type defined
-- in the container package.
OSDN Git Service
