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:
Arnaud Charlet
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>
|
||||
|
||||
* 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);
|
||||
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'
|
||||
|
|
|
|||
|
|
@ -4942,10 +4942,10 @@ package body Exp_Ch3 is
|
|||
---------------------------------
|
||||
|
||||
procedure Expand_N_Object_Declaration (N : Node_Id) is
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -5451,8 +5451,8 @@ 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
|
||||
GM : constant Ghost_Mode_Type := Ghost_Mode;
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
GM : constant Ghost_Mode_Type := Ghost_Mode;
|
||||
Subp : constant Entity_Id := Defining_Entity (N);
|
||||
Scop : constant Entity_Id := Scope (Subp);
|
||||
Prot_Bod : Node_Id;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -121,8 +121,8 @@ 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
|
||||
|
|
@ -131,8 +131,8 @@ package body Ghost is
|
|||
|
||||
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);
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
|
|
@ -7763,14 +7763,14 @@ package body Sem_Ch13 is
|
|||
function Build_Invariant_Procedure_Declaration
|
||||
(Typ : Entity_Id) return Node_Id
|
||||
is
|
||||
GM : constant Ghost_Mode_Type := Ghost_Mode;
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
GM : constant Ghost_Mode_Type := Ghost_Mode;
|
||||
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));
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
Act_T : Entity_Id;
|
||||
T : Entity_Id;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue