From ad4ba28bb0d6acbd78ca6f2da71d987f6bd17ea6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 26 May 2015 12:49:18 +0200 Subject: [PATCH] [multiple changes] 2015-05-26 Robert Dewar * exp_prag.adb, sem_ch3.adb, sem_ch5.adb, exp_ch11.adb, ghost.adb, exp_ch6.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, sem_ch13.adb, exp_ch3.adb: Minor reformatting. 2015-05-26 Bob Duff * treepr.adb: Minor improvement to debugging routines (pp, pn) robustness. Rearrange the code so passing a nonexistent Node_Id prints "No such node" rather than crashing, and causing gdb to generate confusing messages. 2015-05-26 Gary Dismukes * sem_util.adb: Minor typo fix. 2015-05-26 Yannick Moy * sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs. From-SVN: r223685 --- gcc/ada/ChangeLog | 21 +++++++++++++++++++++ gcc/ada/exp_ch11.adb | 7 ++++--- gcc/ada/exp_ch3.adb | 16 ++++++++-------- gcc/ada/exp_ch6.adb | 10 +++++----- gcc/ada/exp_prag.adb | 7 ++++--- gcc/ada/ghost.adb | 30 +++++++++++++++--------------- gcc/ada/sem_aux.adb | 8 ++++---- gcc/ada/sem_ch11.adb | 4 ++-- gcc/ada/sem_ch13.adb | 6 +++--- gcc/ada/sem_ch3.adb | 14 +++++++------- gcc/ada/sem_ch5.adb | 4 ++-- gcc/ada/sem_ch6.adb | 4 ++-- gcc/ada/sem_ch8.adb | 6 ++++-- gcc/ada/sem_util.adb | 2 +- gcc/ada/treepr.adb | 22 +++++++++++++++++----- 15 files changed, 99 insertions(+), 62 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d3ef056bf31..c04227408fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2015-05-26 Robert Dewar + + * exp_prag.adb, sem_ch3.adb, sem_ch5.adb, exp_ch11.adb, ghost.adb, + exp_ch6.adb, sem_ch6.adb, sem_ch8.adb, sem_ch11.adb, sem_ch13.adb, + exp_ch3.adb: Minor reformatting. + +2015-05-26 Bob Duff + + * treepr.adb: Minor improvement to debugging routines (pp, pn) + robustness. Rearrange the code so passing a nonexistent Node_Id + prints "No such node" rather than crashing, and causing gdb to + generate confusing messages. + +2015-05-26 Gary Dismukes + + * sem_util.adb: Minor typo fix. + +2015-05-26 Yannick Moy + + * sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs. + 2015-05-26 Hristian Kirtchev * exp_ch3.adb (Expand_N_Full_Type_Declaration): Capture, set and diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index dd0423a5a50..47c373081b3 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1191,11 +1191,11 @@ package body Exp_Ch11 is procedure Expand_N_Exception_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); - Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); + Loc : constant Source_Ptr := Sloc (N); Ex_Id : Entity_Id; Flag_Id : Entity_Id; - L : List_Id := New_List; + L : List_Id; procedure Force_Static_Allocation_Of_Referenced_Objects (Aggregate : Node_Id); @@ -1304,6 +1304,7 @@ package body Exp_Ch11 is -- Create the aggregate list for type Standard.Exception_Type: -- Handled_By_Other component: False + L := Empty_List; Append_To (L, New_Occurrence_Of (Standard_False, Loc)); -- Lang component: 'A' diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d7f453417d5..714176948a5 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4792,8 +4792,8 @@ package body Exp_Ch3 is -- Local declarations - Def_Id : constant Entity_Id := Defining_Identifier (N); - B_Id : constant Entity_Id := Base_Type (Def_Id); + Def_Id : constant Entity_Id := Defining_Identifier (N); + B_Id : constant Entity_Id := Base_Type (Def_Id); GM : constant Ghost_Mode_Type := Ghost_Mode; FN : Node_Id; Par_Id : Entity_Id; @@ -4942,13 +4942,13 @@ package body Exp_Ch3 is --------------------------------- procedure Expand_N_Object_Declaration (N : Node_Id) is - Def_Id : constant Entity_Id := Defining_Identifier (N); - Expr : constant Node_Id := Expression (N); + Loc : constant Source_Ptr := Sloc (N); + Def_Id : constant Entity_Id := Defining_Identifier (N); + Expr : constant Node_Id := Expression (N); GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (N); - Obj_Def : constant Node_Id := Object_Definition (N); - Typ : constant Entity_Id := Etype (Def_Id); - Base_Typ : constant Entity_Id := Base_Type (Typ); + Obj_Def : constant Node_Id := Object_Definition (N); + Typ : constant Entity_Id := Etype (Def_Id); + Base_Typ : constant Entity_Id := Base_Type (Typ); Expr_Q : Node_Id; function Build_Equivalent_Aggregate return Boolean; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 01081a0cd0f..5afaf49cd08 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5006,8 +5006,8 @@ package body Exp_Ch6 is procedure Expand_N_Subprogram_Body (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (N); - HSS : constant Node_Id := Handled_Statement_Sequence (N); + Loc : constant Source_Ptr := Sloc (N); + HSS : constant Node_Id := Handled_Statement_Sequence (N); Body_Id : Entity_Id; Except_H : Node_Id; L : List_Id; @@ -5451,10 +5451,10 @@ package body Exp_Ch6 is -- If the declaration is for a null procedure, emit null body procedure Expand_N_Subprogram_Declaration (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (N); - Subp : constant Entity_Id := Defining_Entity (N); - Scop : constant Entity_Id := Scope (Subp); + Subp : constant Entity_Id := Defining_Entity (N); + Scop : constant Entity_Id := Scope (Subp); Prot_Bod : Node_Id; Prot_Decl : Node_Id; Prot_Id : Entity_Id; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index fab3facddc3..d47e31c7cec 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -294,8 +294,8 @@ package body Exp_Prag is procedure Expand_Pragma_Check (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Cond : constant Node_Id := Arg2 (N); - Nam : constant Name_Id := Chars (Arg1 (N)); + Cond : constant Node_Id := Arg2 (N); + Nam : constant Name_Id := Chars (Arg1 (N)); Msg : Node_Id; Loc : constant Source_Ptr := Sloc (First_Node (Cond)); @@ -1580,8 +1580,9 @@ package body Exp_Prag is -- end loop; procedure Expand_Pragma_Loop_Variant (N : Node_Id) is - Last_Var : constant Node_Id := Last (Pragma_Argument_Associations (N)); Loc : constant Source_Ptr := Sloc (N); + Last_Var : constant Node_Id := + Last (Pragma_Argument_Associations (N)); Curr_Assign : List_Id := No_List; Flag_Id : Entity_Id := Empty; diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 75ceb4b2b58..05295a0e3c3 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -121,18 +121,18 @@ package body Ghost is Error_Msg_N ("incompatible ghost policies in effect", Partial_View); Error_Msg_N ("\& declared with ghost policy `Check`", Partial_View); - Error_Msg_N - ("\& completed # with ghost policy `Ignore`", Partial_View); + Error_Msg_N ("\& completed # with ghost policy `Ignore`", + Partial_View); elsif Is_Ignored_Ghost_Entity (Partial_View) and then Policy = Name_Check then Error_Msg_Sloc := Sloc (Full_View); - Error_Msg_N ("incompatible ghost policies in effect", Partial_View); + Error_Msg_N ("incompatible ghost policies in effect", Partial_View); Error_Msg_N ("\& declared with ghost policy `Ignore`", Partial_View); - Error_Msg_N - ("\& completed # with ghost policy `Check`", Partial_View); + Error_Msg_N ("\& completed # with ghost policy `Check`", + Partial_View); end if; end Check_Ghost_Completion; @@ -300,7 +300,8 @@ package body Ghost is if GP = Name_Ignore and then AP /= Name_Ignore then Error_Msg_N - ("incompatible ghost policies in effect", Ghost_Ref); + ("incompatible ghost policies in effect", + Ghost_Ref); Error_Msg_NE ("\ghost entity & has policy `Ignore`", Ghost_Ref, Ghost_Id); @@ -494,14 +495,14 @@ package body Ghost is Error_Msg_N ("incompatible ghost policies in effect", Err_N); Error_Msg_NE ("\& declared with ghost policy `Check`", Err_N, Id); - Error_Msg_NE ("\& used # with ghost policy `Ignore`", Err_N, Id); + Error_Msg_NE ("\& used # with ghost policy `Ignore`", Err_N, Id); elsif Is_Ignored_Ghost_Entity (Id) and then Policy = Name_Check then Error_Msg_Sloc := Sloc (Err_N); - Error_Msg_N ("incompatible ghost policies in effect", Err_N); + Error_Msg_N ("incompatible ghost policies in effect", Err_N); Error_Msg_NE ("\& declared with ghost policy `Ignore`", Err_N, Id); - Error_Msg_NE ("\& used # with ghost policy `Check`", Err_N, Id); + Error_Msg_NE ("\& used # with ghost policy `Check`", Err_N, Id); end if; end Check_Ghost_Policy; @@ -558,7 +559,7 @@ package body Ghost is if not Is_Ghost_Entity (Iface) then Error_Msg_N ("type extension & cannot be ghost", Typ); - Error_Msg_NE ("\interface type & is not ghost", Typ, Iface); + Error_Msg_NE ("\interface type & is not ghost", Typ, Iface); return; end if; @@ -587,10 +588,10 @@ package body Ghost is if Is_Checked_Ghost_Entity (Par_Subp) and then Is_Ignored_Ghost_Entity (Subp) then - Error_Msg_N ("incompatible ghost policies in effect", Subp); + Error_Msg_N ("incompatible ghost policies in effect", Subp); Error_Msg_Sloc := Sloc (Par_Subp); - Error_Msg_N ("\& declared # with ghost policy `Check`", Subp); + Error_Msg_N ("\& declared # with ghost policy `Check`", Subp); Error_Msg_Sloc := Sloc (Subp); Error_Msg_N ("\overridden # with ghost policy `Ignore`", Subp); @@ -598,13 +599,13 @@ package body Ghost is elsif Is_Ignored_Ghost_Entity (Par_Subp) and then Is_Checked_Ghost_Entity (Subp) then - Error_Msg_N ("incompatible ghost policies in effect", Subp); + Error_Msg_N ("incompatible ghost policies in effect", Subp); Error_Msg_Sloc := Sloc (Par_Subp); Error_Msg_N ("\& declared # with ghost policy `Ignore`", Subp); Error_Msg_Sloc := Sloc (Subp); - Error_Msg_N ("\overridden # with ghost policy `Check`", Subp); + Error_Msg_N ("\overridden # with ghost policy `Check`", Subp); end if; end if; end Check_Ghost_Overriding; @@ -1158,7 +1159,6 @@ package body Ghost is begin if Is_Checked_Ghost_Entity (Id) then Ghost_Mode := Check; - elsif Is_Ignored_Ghost_Entity (Id) then Ghost_Mode := Ignore; end if; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index ef88959cc6a..31644b076e3 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1524,15 +1524,15 @@ package body Sem_Aux is N := Parent (Subprogram_Specification (E)); -- If this declaration is not a subprogram body, then it must be a - -- subprogram declaration, from which we can retrieve the entity for - -- the corresponding subprogram body if any, or an abstract subprogram - -- declaration, for which we return Empty. + -- subprogram declaration or body stub, from which we can retrieve the + -- entity for the corresponding subprogram body if any, or an abstract + -- subprogram declaration, for which we return Empty. case Nkind (N) is when N_Subprogram_Body => return E; - when N_Subprogram_Declaration => + when N_Subprogram_Declaration | N_Subprogram_Body_Stub => return Corresponding_Body (N); when others => diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index e1ff0c1c871..82b59e92d7f 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -56,8 +56,8 @@ package body Sem_Ch11 is procedure Analyze_Exception_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); - PF : constant Boolean := Is_Pure (Current_Scope); + Id : constant Entity_Id := Defining_Identifier (N); + PF : constant Boolean := Is_Pure (Current_Scope); begin -- The exception declaration may be subject to pragma Ghost with policy diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8db5b5088a0..d994ba3fe02 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7763,14 +7763,14 @@ package body Sem_Ch13 is function Build_Invariant_Procedure_Declaration (Typ : Entity_Id) return Node_Id is + Loc : constant Source_Ptr := Sloc (Typ); GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (Typ); Decl : Node_Id; Obj_Id : Entity_Id; SId : Entity_Id; begin - -- Check for duplicate definiations + -- Check for duplicate definitions if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then return Empty; @@ -8011,7 +8011,7 @@ package body Sem_Ch13 is -- analyzed at the end of the private part, but that yields the -- wrong visibility. - -- Historic note: we used to set N as the parent, but a package + -- Historical note: we used to set N as the parent, but a package -- specification as the parent of an expression is bizarre. Set_Parent (Expr, Parent (Arg2)); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fa84de419c1..df86250b286 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2556,8 +2556,8 @@ package body Sem_Ch3 is ----------------------------------- procedure Analyze_Full_Type_Declaration (N : Node_Id) is - Def : constant Node_Id := Type_Definition (N); - Def_Id : constant Entity_Id := Defining_Identifier (N); + Def : constant Node_Id := Type_Definition (N); + Def_Id : constant Entity_Id := Defining_Identifier (N); GM : constant Ghost_Mode_Type := Ghost_Mode; T : Entity_Id; Prev : Entity_Id; @@ -2923,7 +2923,7 @@ package body Sem_Ch3 is ---------------------------------- procedure Analyze_Incomplete_Type_Decl (N : Node_Id) is - F : constant Boolean := Is_Pure (Current_Scope); + F : constant Boolean := Is_Pure (Current_Scope); GM : constant Ghost_Mode_Type := Ghost_Mode; T : Entity_Id; @@ -3406,9 +3406,9 @@ package body Sem_Ch3 is -------------------------------- procedure Analyze_Object_Declaration (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); - Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); Act_T : Entity_Id; T : Entity_Id; @@ -4544,8 +4544,8 @@ package body Sem_Ch3 is procedure Analyze_Private_Extension_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Indic : constant Node_Id := Subtype_Indication (N); - T : constant Entity_Id := Defining_Identifier (N); + Indic : constant Node_Id := Subtype_Indication (N); + T : constant Entity_Id := Defining_Identifier (N); Parent_Base : Entity_Id; Parent_Type : Entity_Id; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 162e6db03a8..2b2e918da36 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -91,8 +91,8 @@ package body Sem_Ch5 is procedure Analyze_Assignment (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Lhs : constant Node_Id := Name (N); - Rhs : constant Node_Id := Expression (N); + Lhs : constant Node_Id := Name (N); + Rhs : constant Node_Id := Expression (N); T1 : Entity_Id; T2 : Entity_Id; Decl : Node_Id; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 07579f0fcb0..a225883e668 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -210,8 +210,8 @@ package body Sem_Ch6 is procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; - Scop : constant Entity_Id := Current_Scope; - Subp_Id : constant Entity_Id := + Scop : constant Entity_Id := Current_Scope; + Subp_Id : constant Entity_Id := Analyze_Subprogram_Specification (Specification (N)); begin diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 239fadc2f2b..df1eff32b9f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -672,7 +672,9 @@ package body Sem_Ch8 is GM : constant Ghost_Mode_Type := Ghost_Mode; New_P : constant Entity_Id := Defining_Entity (N); Old_P : Entity_Id; - Inst : Boolean := False; -- prevent junk warning + + Inst : Boolean := False; + -- Prevent junk warning begin if Name (N) = Error then @@ -2646,7 +2648,7 @@ package body Sem_Ch8 is -- type is class-wide. GM : constant Ghost_Mode_Type := Ghost_Mode; - Inst_Node : Node_Id := Empty; + Inst_Node : Node_Id := Empty; New_S : Entity_Id; -- Start of processing for Analyze_Subprogram_Renaming diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c7d220cca19..08a6fbb3bab 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -17003,7 +17003,7 @@ package body Sem_Util is Comp := First_Entity (Typ); while Present (Comp) loop if Ekind (Comp) = E_Component then - -- ???It's not cleare we need a full recursive call to + -- ???It's not clear we need a full recursive call to -- Requires_Transient_Scope here. Note that the following -- can't happen. diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 8ad81b9ed1c..d11a12bbe9c 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -974,7 +974,7 @@ package body Treepr is Prefix_Char : Character) is F : Fchar; - P : Natural := Pchar_Pos (Nkind (N)); + P : Natural; Field_To_Be_Printed : Boolean; Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1); @@ -987,10 +987,14 @@ package body Treepr is return; end if; - if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then - Fmt := Hex; - else - Fmt := Auto; + -- If there is no such node, indicate that. Skip the rest, so we don't + -- crash getting fields of the nonexistent node. + + if N > Atree_Private_Part.Nodes.Last then + Print_Str ("No such node: "); + Print_Int (Int (N)); + Print_Eol; + return; end if; Prefix_Str_Char (Prefix_Str'Range) := Prefix_Str; @@ -1184,6 +1188,14 @@ package body Treepr is -- Loop to print fields included in Pchars array + P := Pchar_Pos (Nkind (N)); + + if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then + Fmt := Hex; + else + Fmt := Auto; + end if; + while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) loop F := Pchars (P); P := P + 1; -- 2.30.2