mirror of git://gcc.gnu.org/git/gcc.git
				
				
				
			[multiple changes]
2015-05-26 Robert Dewar <dewar@adacore.com> * 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 <duff@adacore.com> * 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 <dismukes@adacore.com> * sem_util.adb: Minor typo fix. 2015-05-26 Yannick Moy <moy@adacore.com> * sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs. From-SVN: r223685
This commit is contained in:
		
							parent
							
								
									241ebe892a
								
							
						
					
					
						commit
						ad4ba28bb0
					
				|  | @ -1,3 +1,24 @@ | ||||||
|  | 2015-05-26  Robert Dewar  <dewar@adacore.com> | ||||||
|  | 
 | ||||||
|  | 	* 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  <duff@adacore.com> | ||||||
|  | 
 | ||||||
|  | 	* 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  <dismukes@adacore.com> | ||||||
|  | 
 | ||||||
|  | 	* sem_util.adb: Minor typo fix. | ||||||
|  | 
 | ||||||
|  | 2015-05-26  Yannick Moy  <moy@adacore.com> | ||||||
|  | 
 | ||||||
|  | 	* sem_aux.adb (Subprogram_Body_Entity): Deal with subprogram stubs. | ||||||
|  | 
 | ||||||
| 2015-05-26  Hristian Kirtchev  <kirtchev@adacore.com> | 2015-05-26  Hristian Kirtchev  <kirtchev@adacore.com> | ||||||
| 
 | 
 | ||||||
| 	* exp_ch3.adb (Expand_N_Full_Type_Declaration): Capture, set and | 	* exp_ch3.adb (Expand_N_Full_Type_Declaration): Capture, set and | ||||||
|  |  | ||||||
|  | @ -1195,7 +1195,7 @@ package body Exp_Ch11 is | ||||||
|       Loc     : constant Source_Ptr      := Sloc (N); |       Loc     : constant Source_Ptr      := Sloc (N); | ||||||
|       Ex_Id   : Entity_Id; |       Ex_Id   : Entity_Id; | ||||||
|       Flag_Id : Entity_Id; |       Flag_Id : Entity_Id; | ||||||
|       L       : List_Id := New_List; |       L       : List_Id; | ||||||
| 
 | 
 | ||||||
|       procedure Force_Static_Allocation_Of_Referenced_Objects |       procedure Force_Static_Allocation_Of_Referenced_Objects | ||||||
|         (Aggregate : Node_Id); |         (Aggregate : Node_Id); | ||||||
|  | @ -1304,6 +1304,7 @@ package body Exp_Ch11 is | ||||||
|       --  Create the aggregate list for type Standard.Exception_Type: |       --  Create the aggregate list for type Standard.Exception_Type: | ||||||
|       --  Handled_By_Other component: False |       --  Handled_By_Other component: False | ||||||
| 
 | 
 | ||||||
|  |       L := Empty_List; | ||||||
|       Append_To (L, New_Occurrence_Of (Standard_False, Loc)); |       Append_To (L, New_Occurrence_Of (Standard_False, Loc)); | ||||||
| 
 | 
 | ||||||
|       --  Lang component: 'A' |       --  Lang component: 'A' | ||||||
|  |  | ||||||
|  | @ -4942,10 +4942,10 @@ package body Exp_Ch3 is | ||||||
|    --------------------------------- |    --------------------------------- | ||||||
| 
 | 
 | ||||||
|    procedure Expand_N_Object_Declaration (N : Node_Id) is |    procedure Expand_N_Object_Declaration (N : Node_Id) is | ||||||
|  |       Loc      : constant Source_Ptr      := Sloc (N); | ||||||
|       Def_Id   : constant Entity_Id       := Defining_Identifier (N); |       Def_Id   : constant Entity_Id       := Defining_Identifier (N); | ||||||
|       Expr     : constant Node_Id         := Expression (N); |       Expr     : constant Node_Id         := Expression (N); | ||||||
|       GM       : constant Ghost_Mode_Type := Ghost_Mode; |       GM       : constant Ghost_Mode_Type := Ghost_Mode; | ||||||
|       Loc      : constant Source_Ptr := Sloc (N); |  | ||||||
|       Obj_Def  : constant Node_Id         := Object_Definition (N); |       Obj_Def  : constant Node_Id         := Object_Definition (N); | ||||||
|       Typ      : constant Entity_Id       := Etype (Def_Id); |       Typ      : constant Entity_Id       := Etype (Def_Id); | ||||||
|       Base_Typ : constant Entity_Id       := Base_Type (Typ); |       Base_Typ : constant Entity_Id       := Base_Type (Typ); | ||||||
|  |  | ||||||
|  | @ -5451,8 +5451,8 @@ package body Exp_Ch6 is | ||||||
|    --  If the declaration is for a null procedure, emit null body |    --  If the declaration is for a null procedure, emit null body | ||||||
| 
 | 
 | ||||||
|    procedure Expand_N_Subprogram_Declaration (N : Node_Id) is |    procedure Expand_N_Subprogram_Declaration (N : Node_Id) is | ||||||
|       GM        : constant Ghost_Mode_Type := Ghost_Mode; |  | ||||||
|       Loc       : constant Source_Ptr      := Sloc (N); |       Loc       : constant Source_Ptr      := Sloc (N); | ||||||
|  |       GM        : constant Ghost_Mode_Type := Ghost_Mode; | ||||||
|       Subp      : constant Entity_Id       := Defining_Entity (N); |       Subp      : constant Entity_Id       := Defining_Entity (N); | ||||||
|       Scop      : constant Entity_Id       := Scope (Subp); |       Scop      : constant Entity_Id       := Scope (Subp); | ||||||
|       Prot_Bod  : Node_Id; |       Prot_Bod  : Node_Id; | ||||||
|  |  | ||||||
|  | @ -1580,8 +1580,9 @@ package body Exp_Prag is | ||||||
|    --     end loop; |    --     end loop; | ||||||
| 
 | 
 | ||||||
|    procedure Expand_Pragma_Loop_Variant (N : Node_Id) is |    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); |       Loc      : constant Source_Ptr := Sloc (N); | ||||||
|  |       Last_Var : constant Node_Id    := | ||||||
|  |                    Last (Pragma_Argument_Associations (N)); | ||||||
| 
 | 
 | ||||||
|       Curr_Assign : List_Id   := No_List; |       Curr_Assign : List_Id   := No_List; | ||||||
|       Flag_Id     : Entity_Id := Empty; |       Flag_Id     : Entity_Id := Empty; | ||||||
|  |  | ||||||
|  | @ -121,8 +121,8 @@ package body Ghost is | ||||||
| 
 | 
 | ||||||
|          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 `Check`", Partial_View); |          Error_Msg_N ("\& declared with ghost policy `Check`", Partial_View); | ||||||
|          Error_Msg_N |          Error_Msg_N ("\& completed # with ghost policy `Ignore`", | ||||||
|            ("\& completed # with ghost policy `Ignore`", Partial_View); |                                                                Partial_View); | ||||||
| 
 | 
 | ||||||
|       elsif Is_Ignored_Ghost_Entity (Partial_View) |       elsif Is_Ignored_Ghost_Entity (Partial_View) | ||||||
|         and then Policy = Name_Check |         and then Policy = Name_Check | ||||||
|  | @ -131,8 +131,8 @@ package body Ghost is | ||||||
| 
 | 
 | ||||||
|          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 ("\& declared with ghost policy `Ignore`", Partial_View); | ||||||
|          Error_Msg_N |          Error_Msg_N ("\& completed # with ghost policy `Check`", | ||||||
|            ("\& completed # with ghost policy `Check`", Partial_View); |                                                                 Partial_View); | ||||||
|       end if; |       end if; | ||||||
|    end Check_Ghost_Completion; |    end Check_Ghost_Completion; | ||||||
| 
 | 
 | ||||||
|  | @ -300,7 +300,8 @@ package body Ghost is | ||||||
| 
 | 
 | ||||||
|                if GP = Name_Ignore and then AP /= Name_Ignore then |                if GP = Name_Ignore and then AP /= Name_Ignore then | ||||||
|                   Error_Msg_N |                   Error_Msg_N | ||||||
|                     ("incompatible ghost policies in effect", Ghost_Ref); |                     ("incompatible ghost policies in effect", | ||||||
|  |                      Ghost_Ref); | ||||||
|                   Error_Msg_NE |                   Error_Msg_NE | ||||||
|                     ("\ghost entity & has policy `Ignore`", |                     ("\ghost entity & has policy `Ignore`", | ||||||
|                      Ghost_Ref, Ghost_Id); |                      Ghost_Ref, Ghost_Id); | ||||||
|  | @ -1158,7 +1159,6 @@ package body Ghost is | ||||||
|    begin |    begin | ||||||
|       if Is_Checked_Ghost_Entity (Id) then |       if Is_Checked_Ghost_Entity (Id) then | ||||||
|          Ghost_Mode := Check; |          Ghost_Mode := Check; | ||||||
| 
 |  | ||||||
|       elsif Is_Ignored_Ghost_Entity (Id) then |       elsif Is_Ignored_Ghost_Entity (Id) then | ||||||
|          Ghost_Mode := Ignore; |          Ghost_Mode := Ignore; | ||||||
|       end if; |       end if; | ||||||
|  |  | ||||||
|  | @ -1524,15 +1524,15 @@ package body Sem_Aux is | ||||||
|       N := Parent (Subprogram_Specification (E)); |       N := Parent (Subprogram_Specification (E)); | ||||||
| 
 | 
 | ||||||
|       --  If this declaration is not a subprogram body, then it must be a |       --  If this declaration is not a subprogram body, then it must be a | ||||||
|       --  subprogram declaration, from which we can retrieve the entity for |       --  subprogram declaration or body stub, from which we can retrieve the | ||||||
|       --  the corresponding subprogram body if any, or an abstract subprogram |       --  entity for the corresponding subprogram body if any, or an abstract | ||||||
|       --  declaration, for which we return Empty. |       --  subprogram declaration, for which we return Empty. | ||||||
| 
 | 
 | ||||||
|       case Nkind (N) is |       case Nkind (N) is | ||||||
|          when N_Subprogram_Body => |          when N_Subprogram_Body => | ||||||
|             return E; |             return E; | ||||||
| 
 | 
 | ||||||
|          when N_Subprogram_Declaration => |          when N_Subprogram_Declaration | N_Subprogram_Body_Stub => | ||||||
|             return Corresponding_Body (N); |             return Corresponding_Body (N); | ||||||
| 
 | 
 | ||||||
|          when others => |          when others => | ||||||
|  |  | ||||||
|  | @ -7763,14 +7763,14 @@ package body Sem_Ch13 is | ||||||
|    function Build_Invariant_Procedure_Declaration |    function Build_Invariant_Procedure_Declaration | ||||||
|      (Typ : Entity_Id) return Node_Id |      (Typ : Entity_Id) return Node_Id | ||||||
|    is |    is | ||||||
|       GM     : constant Ghost_Mode_Type := Ghost_Mode; |  | ||||||
|       Loc    : constant Source_Ptr      := Sloc (Typ); |       Loc    : constant Source_Ptr      := Sloc (Typ); | ||||||
|  |       GM     : constant Ghost_Mode_Type := Ghost_Mode; | ||||||
|       Decl   : Node_Id; |       Decl   : Node_Id; | ||||||
|       Obj_Id : Entity_Id; |       Obj_Id : Entity_Id; | ||||||
|       SId    : Entity_Id; |       SId    : Entity_Id; | ||||||
| 
 | 
 | ||||||
|    begin |    begin | ||||||
|       --  Check for duplicate definiations |       --  Check for duplicate definitions | ||||||
| 
 | 
 | ||||||
|       if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then |       if Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)) then | ||||||
|          return Empty; |          return Empty; | ||||||
|  | @ -8011,7 +8011,7 @@ package body Sem_Ch13 is | ||||||
|             --  analyzed at the end of the private part, but that yields the |             --  analyzed at the end of the private part, but that yields the | ||||||
|             --  wrong visibility. |             --  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. |             --  specification as the parent of an expression is bizarre. | ||||||
| 
 | 
 | ||||||
|             Set_Parent (Expr, Parent (Arg2)); |             Set_Parent (Expr, Parent (Arg2)); | ||||||
|  |  | ||||||
|  | @ -3406,9 +3406,9 @@ package body Sem_Ch3 is | ||||||
|    -------------------------------- |    -------------------------------- | ||||||
| 
 | 
 | ||||||
|    procedure Analyze_Object_Declaration (N : Node_Id) is |    procedure Analyze_Object_Declaration (N : Node_Id) is | ||||||
|  |       Loc   : constant Source_Ptr      := Sloc (N); | ||||||
|       GM    : constant Ghost_Mode_Type := Ghost_Mode; |       GM    : constant Ghost_Mode_Type := Ghost_Mode; | ||||||
|       Id    : constant Entity_Id       := Defining_Identifier (N); |       Id    : constant Entity_Id       := Defining_Identifier (N); | ||||||
|       Loc   : constant Source_Ptr := Sloc (N); |  | ||||||
|       Act_T : Entity_Id; |       Act_T : Entity_Id; | ||||||
|       T     : Entity_Id; |       T     : Entity_Id; | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -672,7 +672,9 @@ package body Sem_Ch8 is | ||||||
|       GM    : constant Ghost_Mode_Type := Ghost_Mode; |       GM    : constant Ghost_Mode_Type := Ghost_Mode; | ||||||
|       New_P : constant Entity_Id       := Defining_Entity (N); |       New_P : constant Entity_Id       := Defining_Entity (N); | ||||||
|       Old_P : Entity_Id; |       Old_P : Entity_Id; | ||||||
|       Inst  : Boolean := False; -- prevent junk warning | 
 | ||||||
|  |       Inst  : Boolean := False; | ||||||
|  |       --  Prevent junk warning | ||||||
| 
 | 
 | ||||||
|    begin |    begin | ||||||
|       if Name (N) = Error then |       if Name (N) = Error then | ||||||
|  |  | ||||||
|  | @ -17003,7 +17003,7 @@ package body Sem_Util is | ||||||
|             Comp := First_Entity (Typ); |             Comp := First_Entity (Typ); | ||||||
|             while Present (Comp) loop |             while Present (Comp) loop | ||||||
|                if Ekind (Comp) = E_Component then |                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 |                   --  Requires_Transient_Scope here. Note that the following | ||||||
|                   --  can't happen. |                   --  can't happen. | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -974,7 +974,7 @@ package body Treepr is | ||||||
|       Prefix_Char : Character) |       Prefix_Char : Character) | ||||||
|    is |    is | ||||||
|       F : Fchar; |       F : Fchar; | ||||||
|       P : Natural := Pchar_Pos (Nkind (N)); |       P : Natural; | ||||||
| 
 | 
 | ||||||
|       Field_To_Be_Printed : Boolean; |       Field_To_Be_Printed : Boolean; | ||||||
|       Prefix_Str_Char     : String (Prefix_Str'First .. Prefix_Str'Last + 1); |       Prefix_Str_Char     : String (Prefix_Str'First .. Prefix_Str'Last + 1); | ||||||
|  | @ -987,10 +987,14 @@ package body Treepr is | ||||||
|          return; |          return; | ||||||
|       end if; |       end if; | ||||||
| 
 | 
 | ||||||
|       if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then |       --  If there is no such node, indicate that. Skip the rest, so we don't | ||||||
|          Fmt := Hex; |       --  crash getting fields of the nonexistent node. | ||||||
|       else | 
 | ||||||
|          Fmt := Auto; |       if N > Atree_Private_Part.Nodes.Last then | ||||||
|  |          Print_Str ("No such node: "); | ||||||
|  |          Print_Int (Int (N)); | ||||||
|  |          Print_Eol; | ||||||
|  |          return; | ||||||
|       end if; |       end if; | ||||||
| 
 | 
 | ||||||
|       Prefix_Str_Char (Prefix_Str'Range)    := Prefix_Str; |       Prefix_Str_Char (Prefix_Str'Range)    := Prefix_Str; | ||||||
|  | @ -1184,6 +1188,14 @@ package body Treepr is | ||||||
| 
 | 
 | ||||||
|       --  Loop to print fields included in Pchars array |       --  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 |       while P < Pchar_Pos (Node_Kind'Succ (Nkind (N))) loop | ||||||
|          F := Pchars (P); |          F := Pchars (P); | ||||||
|          P := P + 1; |          P := P + 1; | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue
	
	 Arnaud Charlet
						Arnaud Charlet