From 3d67b2397ae7eb4d2c384a093cbcac138cf068c7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 24 Apr 2013 16:44:32 +0200 Subject: [multiple changes] 2013-04-24 Hristian Kirtchev * 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 * 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 * 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 * 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. From-SVN: r198242 --- gcc/ada/ChangeLog | 38 ++++++++++++++++++++++++++++++++ gcc/ada/exp_attr.adb | 62 +++++++++++++++++++++++++++++++--------------------- gcc/ada/exp_ch4.adb | 16 +++++++++++--- gcc/ada/par-ch6.adb | 16 ++++++++++++++ gcc/ada/sem_attr.adb | 23 +++++++++++-------- gcc/ada/sem_ch5.adb | 11 +++++++++- gcc/ada/sem_type.adb | 7 +++--- 7 files changed, 132 insertions(+), 41 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5cbe4b1..3a1a5f6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,41 @@ +2013-04-24 Hristian Kirtchev + + * 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 + + * 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 + + * 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 + + * 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 * sem_ch3.adb, sem_ch7.adb: Minor reformatting. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index f904707..c009222 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -782,11 +782,23 @@ package body Exp_Attr is -- '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; @@ -799,6 +811,27 @@ package body Exp_Attr is Set_Has_Loop_Entry_Attributes (Loop_Id); Scheme := Iteration_Scheme (Loop_Stmt); + -- Infinite loops are transformed into: + + -- declare + -- Temp1 : constant := ; + -- . . . + -- TempN : constant := ; + -- begin + -- loop + -- + -- 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 then @@ -817,7 +850,7 @@ package body Exp_Attr is -- 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); @@ -947,27 +980,6 @@ package body Exp_Attr is If_Stmt => Result, Blk_Stmt => Blk); end; - - -- Infinite loops are transformed into: - - -- declare - -- Temp1 : constant := ; - -- . . . - -- TempN : constant := ; - -- begin - -- loop - -- - -- 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); @@ -993,7 +1005,7 @@ package body Exp_Attr is 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. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e1b6cf0..85a6496 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4577,9 +4577,19 @@ package body Exp_Ch4 is -- 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; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 1e96cb2..7531f40 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -838,6 +838,22 @@ package body Ch6 is ("\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 := diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f3845f6..762015f 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3698,6 +3698,7 @@ package body Sem_Attr is -- 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; @@ -3707,6 +3708,13 @@ package body Sem_Attr is -- 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 @@ -3775,6 +3783,8 @@ package body Sem_Attr is Set_Expressions (N, Expressions (Context)); Rewrite (Context, N); Set_Etype (Context, P_Type); + + Attr := Context; end if; end if; end if; @@ -3796,17 +3806,14 @@ package body Sem_Attr is -- 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 @@ -3852,8 +3859,8 @@ package body Sem_Attr is -- 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; @@ -3883,8 +3890,6 @@ package body Sem_Attr is then Error_Attr_P ("prefix of attribute % must denote an entity"); end if; - - Set_Etype (N, P_Type); end Loop_Entry; ------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index c2023cd..2e48721 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2958,7 +2958,16 @@ package body Sem_Ch5 is 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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index fa5c085..c6ad391 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2048,8 +2048,8 @@ package body Sem_Type is -- 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)) @@ -2064,7 +2064,8 @@ package body Sem_Type is (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; -- cgit v1.1