FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated
	check.
	(Subtypes_Statically_Match): Remove duplicate check.
	* sem_prag.adb (Check_Arg_Is_External_Name): Remove duplicate check.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_aggr.adb (Replace_Type): Remove the special processing
	for selected components.
	* exp_attr.adb (Expand_N_Attribute_Reference): Merge the
	processing for attributes Fixed_Value and Integer_Value.
	* exp_util.adb (Side_Effect_Free): Merge the processing for
	qualified expressions, type conversions, and unchecked type
	conversions.
	* g-comlin.adb (Is_In_Config): Merge the processing for No_Space
	and Optional.
	* par-ch3.adb (P_Declarative_Items): Merge the processing for
	tokens function, not, overriding, and procedure.
	* sem_ch6.adb (Fully_Conformant_Expressions): Merge the processing
	for qualified expressions, type conversions, and unchecked
	type conversions.
	* sem_util.adb (Compile_Time_Constraint_Error): Merge the
	processing for Ada 83 and instances.
	(Object_Access_Level): Merge the processing for indexed components
	and selected components.
	* uname.adb (Add_Node_Name): Merge the processing for stubs.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Install_Primitive_Elaboration_Check):
	Do not generate the check when restriction No_Elaboration_Code
	is in effect.

2017-04-27  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Build_Class_Wide_Check): New subsidiary
	of Expand_Dispatching_Call. If the denoted subprogram has a
	class-wide precondition, this is the only precondition that
	applies to the call, rather that the class-wide preconditions
	that may apply to the body that is executed. (This is specified
	in AI12-0195).

From-SVN: r247333
This commit is contained in:
Arnaud Charlet 2017-04-27 15:38:28 +02:00
parent bfc37f375f
commit 304757d2ce
13 changed files with 227 additions and 186 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
gcc/ada/ChangeLog
View file

@ -1,3 +1,47 @@
2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated
check.
(Subtypes_Statically_Match): Remove duplicate check.
* sem_prag.adb (Check_Arg_Is_External_Name): Remove duplicate check.
2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* exp_aggr.adb (Replace_Type): Remove the special processing
for selected components.
* exp_attr.adb (Expand_N_Attribute_Reference): Merge the
processing for attributes Fixed_Value and Integer_Value.
* exp_util.adb (Side_Effect_Free): Merge the processing for
qualified expressions, type conversions, and unchecked type
conversions.
* g-comlin.adb (Is_In_Config): Merge the processing for No_Space
and Optional.
* par-ch3.adb (P_Declarative_Items): Merge the processing for
tokens function, not, overriding, and procedure.
* sem_ch6.adb (Fully_Conformant_Expressions): Merge the processing
for qualified expressions, type conversions, and unchecked
type conversions.
* sem_util.adb (Compile_Time_Constraint_Error): Merge the
processing for Ada 83 and instances.
(Object_Access_Level): Merge the processing for indexed components
and selected components.
* uname.adb (Add_Node_Name): Merge the processing for stubs.
2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Install_Primitive_Elaboration_Check):
Do not generate the check when restriction No_Elaboration_Code
is in effect.
2017-04-27 Ed Schonberg <schonberg@adacore.com>
* exp_disp.adb (Build_Class_Wide_Check): New subsidiary
of Expand_Dispatching_Call. If the denoted subprogram has a
class-wide precondition, this is the only precondition that
applies to the call, rather that the class-wide preconditions
that may apply to the body that is executed. (This is specified
in AI12-0195).
2017-04-27 Yannick Moy <moy@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Issue

6
gcc/ada/checks.adb
View file

@ -7740,7 +7740,6 @@ package body Checks is
-----------------------------------------
procedure Install_Primitive_Elaboration_Check (Subp_Body : Node_Id) is
function Within_Compilation_Unit_Instance
(Subp_Id : Entity_Id) return Boolean;
-- Determine whether subprogram Subp_Id appears within an instance which
@ -7796,6 +7795,11 @@ package body Checks is
if ASIS_Mode or GNATprove_Mode then
return;
-- Do not generate an elaboration check if such code is not desirable
elsif Restriction_Active (No_Elaboration_Code) then
return;
-- Do not generate an elaboration check if the related subprogram is
-- not subjected to accessibility checks.

12
gcc/ada/exp_aggr.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -3042,15 +3042,7 @@ package body Exp_Aggr is
and then Root_Type (Etype (N)) = Root_Type (Entity (Prefix (Expr)))
then
if Is_Entity_Name (Lhs) then
Rewrite (Prefix (Expr),
New_Occurrence_Of (Entity (Lhs), Loc));
elsif Nkind (Lhs) = N_Selected_Component then
Rewrite (Expr,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unrestricted_Access,
Prefix => New_Copy_Tree (Lhs)));
Set_Analyzed (Parent (Expr), False);
Rewrite (Prefix (Expr), New_Occurrence_Of (Entity (Lhs), Loc));
else
Rewrite (Expr,

49
gcc/ada/exp_attr.adb
View file

@ -3360,24 +3360,30 @@ package body Exp_Attr is
end if;
end First_Bit_Attr;
-----------------
-- Fixed_Value --
-----------------
--------------------------------
-- Fixed_Value, Integer_Value --
--------------------------------
-- We transform:
-- We transform
-- fixtype'Fixed_Value (integer-value)
-- inttype'Fixed_Value (fixed-value)
-- into
-- fixtype(integer-value)
-- fixtype (integer-value)
-- inttype (fixed-value)
-- respectively.
-- We do all the required analysis of the conversion here, because we do
-- not want this to go through the fixed-point conversion circuits. Note
-- that the back end always treats fixed-point as equivalent to the
-- corresponding integer type anyway.
when Attribute_Fixed_Value =>
when Attribute_Fixed_Value
| Attribute_Integer_Value
=>
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
@ -3923,37 +3929,6 @@ package body Exp_Attr is
end if;
end Input;
-------------------
-- Integer_Value --
-------------------
-- We transform
-- inttype'Fixed_Value (fixed-value)
-- into
-- inttype(integer-value))
-- we do all the required analysis of the conversion here, because we do
-- not want this to go through the fixed-point conversion circuits. Note
-- that the back end always treats fixed-point as equivalent to the
-- corresponding integer type anyway.
when Attribute_Integer_Value =>
Rewrite (N,
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
Expression => Relocate_Node (First (Exprs))));
Set_Etype (N, Entity (Pref));
Set_Analyzed (N);
-- Note: it might appear that a properly analyzed unchecked
-- conversion would be just fine here, but that's not the case, since
-- the full range check performed by the following call is critical.
Apply_Type_Conversion_Checks (N);
-------------------
-- Invalid_Value --
-------------------

108
gcc/ada/exp_disp.adb
View file

@ -58,6 +58,7 @@ with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
@ -649,11 +650,112 @@ package body Exp_Disp is
Eq_Prim_Op : Entity_Id := Empty;
Controlling_Tag : Node_Id;
procedure Build_Class_Wide_Check;
-- If the denoted subprogram has a class-wide precondition, generate
-- a check using that precondition before the dispatching call, because
-- this is the only class-wide precondition that applies to the call.
function New_Value (From : Node_Id) return Node_Id;
-- From is the original Expression. New_Value is equivalent to a call
-- to Duplicate_Subexpr with an explicit dereference when From is an
-- access parameter.
----------------------------
-- Build_Class_Wide_Check --
----------------------------
procedure Build_Class_Wide_Check is
Prec : Node_Id;
Cond : Node_Id;
Msg : Node_Id;
Str_Loc : constant String := Build_Location_String (Loc);
function Replace_Formals (N : Node_Id) return Traverse_Result;
-- Replace occurrences of the formals of the subprogram by the
-- corresponding actuals in the call, given that this check is
-- performed outside of the body of the subprogram.
---------------------
-- Replace_Formals --
---------------------
function Replace_Formals (N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Is_Formal (Entity (N))
then
declare
A : Node_Id;
F : Entity_Id;
begin
F := First_Formal (Subp);
A := First_Actual (Call_Node);
while Present (F) loop
if F = Entity (N) then
Rewrite (N, New_Copy_Tree (A));
exit;
end if;
Next_Formal (F);
Next_Actual (A);
end loop;
end;
end if;
return OK;
end Replace_Formals;
procedure Update is new Traverse_Proc (Replace_Formals);
begin
-- Locate class-wide precondition, if any
if Present (Contract (Subp))
and then Present (Pre_Post_Conditions (Contract (Subp)))
then
Prec := Pre_Post_Conditions (Contract (Subp));
while Present (Prec) loop
exit when Pragma_Name (Prec) = Name_Precondition
and then Class_Present (Prec);
Prec := Next_Pragma (Prec);
end loop;
if No (Prec) then
return;
end if;
-- The expression for the precondition is analyzed within the
-- generated pragma. The message text is the last parameter
-- of the generated pragma, indicating source of precondition.
Cond := New_Copy_Tree
(Expression (First (Pragma_Argument_Associations (Prec))));
Update (Cond);
-- Build message indicating the failed precondition and the
-- dispatching call that caused it.
Msg := Expression (Last (Pragma_Argument_Associations (Prec)));
Name_Len := 0;
Append (Global_Name_Buffer, Strval (Msg));
Append (Global_Name_Buffer, " in dispatching call at ");
Append (Global_Name_Buffer, Str_Loc);
Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len));
Insert_Action (Call_Node,
Make_If_Statement (Loc,
Condition => Make_Op_Not (Loc, Cond),
Then_Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of
(RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (Msg)))));
end if;
end Build_Class_Wide_Check;
---------------
-- New_Value --
---------------
@ -714,6 +816,8 @@ package body Exp_Disp is
Subp := Alias (Subp);
end if;
Build_Class_Wide_Check;
-- Definition of the class-wide type and the tagged type
-- If the controlling argument is itself a tag rather than a tagged
@ -1174,7 +1278,7 @@ package body Exp_Disp is
if not Tagged_Type_Expansion then
return;
-- A static conversion to an interface type that is not classwide is
-- A static conversion to an interface type that is not class-wide is
-- curious but legal if the interface operation is a null procedure.
-- If the operation is abstract it will be rejected later.
@ -1190,7 +1294,7 @@ package body Exp_Disp is
if not Is_Static then
-- Give error if configurable run time and Displace not available
-- Give error if configurable run-time and Displace not available
if not RTE_Available (RE_Displace) then
Error_Msg_CRT ("dynamic interface conversion", N);

21
gcc/ada/exp_util.adb
View file

@ -12942,10 +12942,13 @@ package body Exp_Util is
Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
and then Safe_Prefixed_Reference (N);
-- A type qualification is side effect free if the expression
-- is side effect free.
-- A type qualification, type conversion, or unchecked expression is
-- side effect free if the expression is side effect free.
when N_Qualified_Expression =>
when N_Qualified_Expression
| N_Type_Conversion
| N_Unchecked_Expression
=>
return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
-- A selected component is side effect free only if it is a side
@ -12969,12 +12972,6 @@ package body Exp_Util is
Side_Effect_Free (Discrete_Range (N), Name_Req, Variable_Ref)
and then Safe_Prefixed_Reference (N);
-- A type conversion is side effect free if the expression to be
-- converted is side effect free.
when N_Type_Conversion =>
return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
-- A unary operator is side effect free if the operand
-- is side effect free.
@ -12990,12 +12987,6 @@ package body Exp_Util is
and then Side_Effect_Free
(Expression (N), Name_Req, Variable_Ref);
-- An unchecked expression is side effect free if its expression
-- is side effect free.
when N_Unchecked_Expression =>
return Side_Effect_Free (Expression (N), Name_Req, Variable_Ref);
-- A literal is side effect free
when N_Character_Literal

11
gcc/ada/g-comlin.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -2002,12 +2002,9 @@ package body GNAT.Command_Line is
Found_In_Config := True;
return False;
when Parameter_No_Space =>
Callback (Switch, "", Parameter, Index);
Found_In_Config := True;
return False;
when Parameter_Optional =>
when Parameter_No_Space
| Parameter_Optional
=>
Callback (Switch, "", Parameter, Index);
Found_In_Config := True;
return False;

27
gcc/ada/par-ch3.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -4319,7 +4319,11 @@ package body Ch3 is
end if;
case Token is
when Tok_Function =>
when Tok_Function
| Tok_Not
| Tok_Overriding
| Tok_Procedure
=>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
Done := False;
@ -4374,20 +4378,6 @@ package body Ch3 is
P_Identifier_Declarations (Decls, Done, In_Spec);
end if;
-- Ada 2005: A subprogram declaration can start with "not" or
-- "overriding". In older versions, "overriding" is handled
-- like an identifier, with the appropriate messages.
when Tok_Not =>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
Done := False;
when Tok_Overriding =>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
Done := False;
when Tok_Package =>
Check_Bad_Layout;
Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
@ -4397,11 +4387,6 @@ package body Ch3 is
Append (P_Pragma, Decls);
Done := False;
when Tok_Procedure =>
Check_Bad_Layout;
Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
Done := False;
when Tok_Protected =>
Check_Bad_Layout;
Scan; -- past PROTECTED

17
gcc/ada/sem_ch6.adb
View file

@ -8981,7 +8981,10 @@ package body Sem_Ch6 is
and then FCE (Explicit_Actual_Parameter (E1),
Explicit_Actual_Parameter (E2));
when N_Qualified_Expression =>
when N_Qualified_Expression
| N_Type_Conversion
| N_Unchecked_Type_Conversion
=>
return
FCE (Subtype_Mark (E1), Subtype_Mark (E2))
and then
@ -9084,24 +9087,12 @@ package body Sem_Ch6 is
end if;
end;
when N_Type_Conversion =>
return
FCE (Subtype_Mark (E1), Subtype_Mark (E2))
and then
FCE (Expression (E1), Expression (E2));
when N_Unary_Op =>
return
Entity (E1) = Entity (E2)
and then
FCE (Right_Opnd (E1), Right_Opnd (E2));
when N_Unchecked_Type_Conversion =>
return
FCE (Subtype_Mark (E1), Subtype_Mark (E2))
and then
FCE (Expression (E1), Expression (E2));
-- All other node types cannot appear in this context. Strictly
-- we should raise a fatal internal error. Instead we just ignore
-- the nodes. This means that if anyone makes a mistake in the

50
gcc/ada/sem_eval.adb
View file

@ -5681,14 +5681,6 @@ package body Sem_Eval is
then
return False;
-- If either type has constraint error bounds, then consider that
-- they match to avoid junk cascaded errors here.
elsif not Is_OK_Static_Subtype (T1)
or else not Is_OK_Static_Subtype (T2)
then
return True;
-- Base types must match, but we don't check that (should we???) but
-- we do at least check that both types are real, or both types are
-- not real.
@ -5708,19 +5700,17 @@ package body Sem_Eval is
begin
if Is_Real_Type (T1) then
return
(Expr_Value_R (LB1) > Expr_Value_R (HB1))
Expr_Value_R (LB1) > Expr_Value_R (HB1)
or else
(Expr_Value_R (LB2) <= Expr_Value_R (LB1)
and then
Expr_Value_R (HB1) <= Expr_Value_R (HB2));
(Expr_Value_R (LB2) <= Expr_Value_R (LB1)
and then Expr_Value_R (HB1) <= Expr_Value_R (HB2));
else
return
(Expr_Value (LB1) > Expr_Value (HB1))
Expr_Value (LB1) > Expr_Value (HB1)
or else
(Expr_Value (LB2) <= Expr_Value (LB1)
and then
Expr_Value (HB1) <= Expr_Value (HB2));
(Expr_Value (LB2) <= Expr_Value (LB1)
and then Expr_Value (HB1) <= Expr_Value (HB2));
end if;
end;
end if;
@ -5728,17 +5718,20 @@ package body Sem_Eval is
-- Access types
elsif Is_Access_Type (T1) then
return (not Is_Constrained (T2)
or else (Subtypes_Statically_Match
(Designated_Type (T1), Designated_Type (T2))))
return
(not Is_Constrained (T2)
or else Subtypes_Statically_Match
(Designated_Type (T1), Designated_Type (T2)))
and then not (Can_Never_Be_Null (T2)
and then not Can_Never_Be_Null (T1));
-- All other cases
else
return (Is_Composite_Type (T1) and then not Is_Constrained (T2))
or else Subtypes_Statically_Match (T1, T2, Formal_Derived_Matching);
return
(Is_Composite_Type (T1) and then not Is_Constrained (T2))
or else Subtypes_Statically_Match
(T1, T2, Formal_Derived_Matching);
end if;
end Subtypes_Statically_Compatible;
@ -5856,23 +5849,16 @@ package body Sem_Eval is
else
if not Is_OK_Static_Subtype (T1)
or else not Is_OK_Static_Subtype (T2)
or else
not Is_OK_Static_Subtype (T2)
then
return False;
-- If either type has constraint error bounds, then say that
-- they match to avoid junk cascaded errors here.
elsif not Is_OK_Static_Subtype (T1)
or else not Is_OK_Static_Subtype (T2)
then
return True;
elsif Is_Real_Type (T1) then
return
(Expr_Value_R (LB1) = Expr_Value_R (LB2))
Expr_Value_R (LB1) = Expr_Value_R (LB2)
and then
(Expr_Value_R (HB1) = Expr_Value_R (HB2));
Expr_Value_R (HB1) = Expr_Value_R (HB2);
else
return

21
gcc/ada/sem_prag.adb
View file

@ -4905,25 +4905,15 @@ package body Sem_Prag is
then
return;
-- Static expression that raises Constraint_Error. This has
-- already been flagged, so just exit from pragma processing.
elsif Is_OK_Static_Expression (Argx) then
raise Pragma_Exit;
-- Here we have a real error (non-static expression)
else
Error_Msg_Name_1 := Pname;
Flag_Non_Static_Expr
(Fix_Error ("argument for pragma% must be a identifier or "
& "static string expression!"), Argx);
declare
Msg : constant String :=
"argument for pragma% must be a identifier or "
& "static string expression!";
begin
Flag_Non_Static_Expr (Fix_Error (Msg), Argx);
raise Pragma_Exit;
end;
raise Pragma_Exit;
end if;
end if;
end Check_Arg_Is_External_Name;
@ -4936,8 +4926,7 @@ package body Sem_Prag is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
begin
if Nkind (Argx) /= N_Identifier then
Error_Pragma_Arg
("argument for pragma% must be identifier", Argx);
Error_Pragma_Arg ("argument for pragma% must be identifier", Argx);
end if;
end Check_Arg_Is_Identifier;

37
gcc/ada/sem_util.adb
View file

@ -4958,8 +4958,8 @@ package body Sem_Util is
Eloc := Sloc (N);
end if;
-- Copy message to Msgc, converting any ? in the message into
-- < instead, so that we have an error in GNATprove mode.
-- Copy message to Msgc, converting any ? in the message into <
-- instead, so that we have an error in GNATprove mode.
Msgl := Msg'Length;
@ -4976,12 +4976,13 @@ package body Sem_Util is
if Msg (Msg'Last) = '?' or else Msg (Msg'Last) = '<' then
Wmsg := True;
-- In Ada 83, all messages are warnings. In the private part and
-- the body of an instance, constraint_checks are only warnings.
-- We also make this a warning if the Warn parameter is set.
-- In Ada 83, all messages are warnings. In the private part and the
-- body of an instance, constraint_checks are only warnings. We also
-- make this a warning if the Warn parameter is set.
elsif Warn
or else (Ada_Version = Ada_83 and then Comes_From_Source (N))
or else In_Instance_Not_Visible
then
Msgl := Msgl + 1;
Msgc (Msgl) := '<';
@ -4989,18 +4990,11 @@ package body Sem_Util is
Msgc (Msgl) := '<';
Wmsg := True;
elsif In_Instance_Not_Visible then
Msgl := Msgl + 1;
Msgc (Msgl) := '<';
Msgl := Msgl + 1;
Msgc (Msgl) := '<';
Wmsg := True;
-- Otherwise we have a real error message (Ada 95 static case)
-- and we make this an unconditional message. Note that in the
-- warning case we do not make the message unconditional, it seems
-- quite reasonable to delete messages like this (about exceptions
-- that will be raised) in dead code.
-- Otherwise we have a real error message (Ada 95 static case) and we
-- make this an unconditional message. Note that in the warning case
-- we do not make the message unconditional, it seems reasonable to
-- delete messages like this (about exceptions that will be raised)
-- in dead code.
else
Wmsg := False;
@ -19118,14 +19112,7 @@ package body Sem_Util is
end if;
end if;
elsif Nkind (Obj) = N_Selected_Component then
if Is_Access_Type (Etype (Prefix (Obj))) then
return Type_Access_Level (Etype (Prefix (Obj)));
else
return Object_Access_Level (Prefix (Obj));
end if;
elsif Nkind (Obj) = N_Indexed_Component then
elsif Nkind_In (Obj, N_Indexed_Component, N_Selected_Component) then
if Is_Access_Type (Etype (Prefix (Obj))) then
return Type_Access_Level (Etype (Prefix (Obj)));
else

10
gcc/ada/uname.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -300,12 +300,8 @@ package body Uname is
when N_Compilation_Unit =>
Add_Node_Name (Unit (Node));
when N_Package_Body_Stub =>
Add_Node_Name (Get_Parent (Node));
Add_Char ('.');
Add_Node_Name (Defining_Identifier (Node));
when N_Protected_Body_Stub
when N_Package_Body_Stub
| N_Protected_Body_Stub
| N_Task_Body_Stub
=>
Add_Node_Name (Get_Parent (Node));