+2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_attr.adb (Expand_Loop_Entry_Attribute): Clarify the
+ extraction of the declarative part of the conditional block. Move
+ the processing of simple infinite loops to the start of the
+ expansion logic. Correct the check which determines whether the
+ proper scope is installed in visibility.
+ * sem_attr.adb (Analyze_Attribute): Add local variable Attr
+ to keep track of the attribute in case the enclosing indexed
+ component has to be rewritten. When searching for the enclosing
+ loop, start from the proper attribute reference in case of a
+ rewriting. Do not allow for 'Loop_Entry to appear in pragma
+ Assert. Replace loop variable J with Index. Set the type of the
+ proper attribute.
+ * sem_ch5.adb (Check_Unreachable_Code): Detect a specialized
+ block that services a loop statement subject to at least one
+ 'Loop_Entry attribute.
+
+2013-04-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_type.adb (Disambiguate): In Ada 2012 mode, when trying to
+ resolve a fixed point operation, use first subtype to determine
+ whether type and operator are declared in the same list of
+ declarations.
+
+2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * par-ch6.adb (P_Subprogram): Detect an illegal
+ placement of the aspect specification list in the context of
+ expression functions.
+
+2013-04-24 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Allocator): If the designated object
+ has tasks, and the pointer type is an itype that has no master
+ id, create a master renaming in the current context, which can
+ only be an init_proc.
+
2013-04-24 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch7.adb: Minor reformatting.
-- 'Loop_Entry attribute. Retrieve the declarative list of the block.
if Has_Loop_Entry_Attributes (Loop_Id) then
+
+ -- When the related loop name appears as the argument of attribute
+ -- Loop_Entry, the corresponding label construct is the generated
+ -- block statement. This happens because the expander reuses the
+ -- label.
+
if Nkind (Loop_Stmt) = N_Block_Statement then
Decls := Declarations (Loop_Stmt);
+
+ -- In all other cases, the loop must appear in the handled sequence
+ -- of statements of the generated block.
+
else
- -- What is going on here??? comments/assertions needed to explain
- -- the assumption being made about the tree???
+ pragma Assert
+ (Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
+ and then Nkind (Parent (Parent (Loop_Stmt))) =
+ N_Block_Statement);
Decls := Declarations (Parent (Parent (Loop_Stmt)));
end if;
Set_Has_Loop_Entry_Attributes (Loop_Id);
Scheme := Iteration_Scheme (Loop_Stmt);
+ -- Infinite loops are transformed into:
+
+ -- declare
+ -- Temp1 : constant <type of Pref1> := <Pref1>;
+ -- . . .
+ -- TempN : constant <type of PrefN> := <PrefN>;
+ -- begin
+ -- loop
+ -- <original source statements with attribute rewrites>
+ -- end loop;
+ -- end;
+
+ if No (Scheme) then
+ Build_Conditional_Block (Loc,
+ Cond => Empty,
+ Loop_Stmt => Relocate_Node (Loop_Stmt),
+ If_Stmt => Result,
+ Blk_Stmt => Blk);
+
+ Result := Blk;
+
-- While loops are transformed into:
-- if <Condition> then
-- Note that loops over iterators and containers are already
-- converted into while loops.
- if Present (Condition (Scheme)) then
+ elsif Present (Condition (Scheme)) then
declare
Cond : constant Node_Id := Condition (Scheme);
If_Stmt => Result,
Blk_Stmt => Blk);
end;
-
- -- Infinite loops are transformed into:
-
- -- declare
- -- Temp1 : constant <type of Pref1> := <Pref1>;
- -- . . .
- -- TempN : constant <type of PrefN> := <PrefN>;
- -- begin
- -- loop
- -- <original source statements with attribute rewrites>
- -- end loop;
- -- end;
-
- else
- Build_Conditional_Block (Loc,
- Cond => Empty,
- Loop_Stmt => Relocate_Node (Loop_Stmt),
- If_Stmt => Result,
- Blk_Stmt => Blk);
-
- Result := Blk;
end if;
Decls := Declarations (Blk);
Rewrite (Attr, New_Reference_To (Temp_Id, Loc));
- Installed := Current_Scope = Loop_Id;
+ Installed := Current_Scope = Scope (Loop_Id);
-- Depending on the pracement of attribute 'Loop_Entry relative to the
-- associated loop, ensure the proper visibility for analysis.
-- access type did not get expanded. Salvage it now.
if not Restriction_Active (No_Task_Hierarchy) then
- pragma Assert (Present (Parent (Base_Type (PtrT))));
- Expand_N_Full_Type_Declaration
- (Parent (Base_Type (PtrT)));
+ if Present (Parent (Base_Type (PtrT))) then
+ Expand_N_Full_Type_Declaration
+ (Parent (Base_Type (PtrT)));
+
+ else
+ -- If the type of the allocator is an itype,
+ -- the master must exist in the context. This
+ -- is the case when the allocator initializes
+ -- an access component in an init-proc.
+
+ pragma Assert (Is_Itype (PtrT));
+ Build_Master_Renaming (PtrT, N);
+ end if;
end if;
end if;
("\unit must be compiled with -gnat2012 switch!");
end if;
+ -- Catch an illegal placement of the aspect specification
+ -- list:
+
+ -- function_specification
+ -- [aspect_specification] is (expression);
+
+ -- This case is correctly processed by the parser because
+ -- the expression function first appears as a subprogram
+ -- declaration to the parser.
+
+ if Is_Non_Empty_List (Aspects) then
+ Error_Msg
+ ("aspect specifications must come after parenthesized "
+ & "expression", Sloc (First (Aspects)));
+ end if;
+
-- Parse out expression and build expression function
Body_Node :=
-- Local variables
Context : constant Node_Id := Parent (N);
+ Attr : Node_Id;
Enclosing_Loop : Node_Id;
In_Loop_Assertion : Boolean := False;
Loop_Id : Entity_Id := Empty;
-- Start of processing for Loop_Entry
begin
+ Attr := N;
+
+ -- Set the type of the attribute now to ensure the successfull
+ -- continuation of analysis even if the attribute is misplaced.
+
+ Set_Etype (Attr, P_Type);
+
-- Attribute 'Loop_Entry may appear in several flavors:
-- * Prefix'Loop_Entry - in this form, the attribute applies to the
Set_Expressions (N, Expressions (Context));
Rewrite (Context, N);
Set_Etype (Context, P_Type);
+
+ Attr := Context;
end if;
end if;
end if;
-- Climb the parent chain to verify the location of the attribute and
-- find the enclosing loop.
- Stmt := N;
+ Stmt := Attr;
while Present (Stmt) loop
- -- Locate the enclosing Loop_Invariant / Loop_Variant pragma (if
- -- any). Note that when these two are expanded, we must look for
- -- an Assertion pragma.
+ -- Locate the enclosing Loop_Invariant / Loop_Variant pragma
if Nkind (Original_Node (Stmt)) = N_Pragma
and then
Nam_In (Pragma_Name (Original_Node (Stmt)),
- Name_Assert,
Name_Loop_Invariant,
Name_Loop_Variant)
then
-- appear within a body of accept statement, if this construct is
-- itself enclosed by the given loop statement.
- for J in reverse 0 .. Scope_Stack.Last loop
- Scop := Scope_Stack.Table (J).Entity;
+ for Index in reverse 0 .. Scope_Stack.Last loop
+ Scop := Scope_Stack.Table (Index).Entity;
if Ekind (Scop) = E_Loop and then Scop = Loop_Id then
exit;
then
Error_Attr_P ("prefix of attribute % must denote an entity");
end if;
-
- Set_Etype (N, P_Type);
end Loop_Entry;
-------------
elsif Nkind (P) = N_Handled_Sequence_Of_Statements
and then Nkind (Parent (P)) = N_Block_Statement
then
- null;
+ -- The original loop is now placed inside a block statement
+ -- due to the expansion of attribute 'Loop_Entry. Return as
+ -- this is not a "real" block for the purposes of exit
+ -- counting.
+
+ if Nkind (N) = N_Loop_Statement
+ and then Subject_To_Loop_Entry_Attributes (N)
+ then
+ return;
+ end if;
-- Statements in exception handler in a block
-- Ditto in Ada 2012, where an ambiguity may arise for an operation
-- on a partial view that is completed with a fixed point type. See
-- AI05-0020 and AI05-0209. The ambiguity is resolved in favor of the
- -- user-defined subprogram so that a client of the package has the
- -- same resulution as the body of the package.
+ -- user-defined type and subprogram, so that a client of the package
+ -- has the same resolution as the body of the package.
else
if (In_Open_Scopes (Scope (User_Subp))
(Ada_Version >= Ada_2012
and then
In_Same_Declaration_List
- (Typ, Unit_Declaration_Node (User_Subp))))
+ (First_Subtype (Typ),
+ Unit_Declaration_Node (User_Subp))))
then
if It2.Nam = Predef_Subp then
return It1;
projects / gcc.git / commitdiff