OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb, sinfo.adb, sinfo.ads, sem.adb, sem_res.adb,
	expander.adb, exp_ch11.adb, exp_ch11.ads, sem_ch11.adb, sem_ch11.ads,
	sprint.adb, sprint.ads: Remove unused node N_Subprogram_Info.

2014-01-23  Emmanuel Briot  <briot@adacore.com>

	* prj-conf.adb (Get_Or_Create_Configuration_File): call
	On_Load_Config later.

2014-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Do not
	generate the spec of the late primitive in ASIS mode. Add two
	comments to explain the special cases when the expansion is
	not performed.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb (Note_Possible_Modification): Fix error of
	misbehaving for implicit dereference cases in -gnatc mode.

2014-01-23  Emmanuel Briot  <briot@adacore.com>

	* prj-pars.adb: Minor reformatting.

From-SVN: r206980
This commit is contained in:
Arnaud Charlet 2014-01-23 17:36:41 +01:00
parent ea15e254ea
commit 53c53f6dc8
17 changed files with 79 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
2014-01-23 Robert Dewar <dewar@adacore.com>
* exp_util.adb, sinfo.adb, sinfo.ads, sem.adb, sem_res.adb,
expander.adb, exp_ch11.adb, exp_ch11.ads, sem_ch11.adb, sem_ch11.ads,
sprint.adb, sprint.ads: Remove unused node N_Subprogram_Info.
2014-01-23 Emmanuel Briot <briot@adacore.com>
* prj-conf.adb (Get_Or_Create_Configuration_File): call
On_Load_Config later.
2014-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Do not
generate the spec of the late primitive in ASIS mode. Add two
comments to explain the special cases when the expansion is
not performed.
2014-01-23 Robert Dewar <dewar@adacore.com>
* sem_util.adb (Note_Possible_Modification): Fix error of
misbehaving for implicit dereference cases in -gnatc mode.
2014-01-23 Emmanuel Briot <briot@adacore.com>
* prj-pars.adb: Minor reformatting.
2014-01-22 Ed Schonberg <schonberg@adacore.com> 2014-01-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram * sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram

21
gcc/ada/exp_ch11.adb
View File

@ -1882,27 +1882,6 @@ package body Exp_Ch11 is
end; end;
end Possible_Local_Raise; end Possible_Local_Raise;
------------------------------
-- Expand_N_Subprogram_Info --
------------------------------
procedure Expand_N_Subprogram_Info (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
begin
-- For now, we replace an Expand_N_Subprogram_Info node with an
-- attribute reference that gives the address of the procedure.
-- This is because gigi does not yet recognize this node, and
-- for the initial targets, this is the right value anyway.
Rewrite (N,
Make_Attribute_Reference (Loc,
Prefix => Identifier (N),
Attribute_Name => Name_Code_Address));
Analyze_And_Resolve (N, RTE (RE_Code_Loc));
end Expand_N_Subprogram_Info;
------------------------ ------------------------
-- Find_Local_Handler -- -- Find_Local_Handler --
------------------------ ------------------------

1
gcc/ada/exp_ch11.ads
View File

@ -35,7 +35,6 @@ package Exp_Ch11 is
procedure Expand_N_Raise_Program_Error (N : Node_Id); procedure Expand_N_Raise_Program_Error (N : Node_Id);
procedure Expand_N_Raise_Statement (N : Node_Id); procedure Expand_N_Raise_Statement (N : Node_Id);
procedure Expand_N_Raise_Storage_Error (N : Node_Id); procedure Expand_N_Raise_Storage_Error (N : Node_Id);
procedure Expand_N_Subprogram_Info (N : Node_Id);
-- Data structures for gathering information to build exception tables -- Data structures for gathering information to build exception tables
-- See runtime routine Ada.Exceptions for full details on the format and -- See runtime routine Ada.Exceptions for full details on the format and

1
gcc/ada/exp_util.adb
View File

@ -3829,7 +3829,6 @@ package body Exp_Util is
N_Single_Protected_Declaration | N_Single_Protected_Declaration |
N_Slice | N_Slice |
N_String_Literal | N_String_Literal |
N_Subprogram_Info |
N_Subtype_Indication | N_Subtype_Indication |
N_Subunit | N_Subunit |
N_Task_Definition | N_Task_Definition |

3
gcc/ada/expander.adb
View File

@ -433,9 +433,6 @@ package body Expander is
when N_Subprogram_Declaration => when N_Subprogram_Declaration =>
Expand_N_Subprogram_Declaration (N); Expand_N_Subprogram_Declaration (N);
when N_Subprogram_Info =>
Expand_N_Subprogram_Info (N);
when N_Task_Body => when N_Task_Body =>
Expand_N_Task_Body (N); Expand_N_Task_Body (N);

13
gcc/ada/prj-conf.adb
View File

@ -1425,12 +1425,7 @@ package body Prj.Conf is
Write_Line (Config_File_Path.all); Write_Line (Config_File_Path.all);
end if; end if;
if On_Load_Config /= null then if Config_File_Path /= null then
On_Load_Config
(Config_File => Config_Project_Node,
Project_Node_Tree => Project_Node_Tree);
elsif Config_File_Path /= null then
Prj.Part.Parse Prj.Part.Parse
(In_Tree => Project_Node_Tree, (In_Tree => Project_Node_Tree,
Project => Config_Project_Node, Project => Config_Project_Node,
@ -1444,6 +1439,12 @@ package body Prj.Conf is
Config_Project_Node := Empty_Node; Config_Project_Node := Empty_Node;
end if; end if;
if On_Load_Config /= null then
On_Load_Config
(Config_File => Config_Project_Node,
Project_Node_Tree => Project_Node_Tree);
end if;
if Config_Project_Node /= Empty_Node then if Config_Project_Node /= Empty_Node then
Prj.Proc.Process_Project_Tree_Phase_1 Prj.Proc.Process_Project_Tree_Phase_1
(In_Tree => Project_Tree, (In_Tree => Project_Tree,

9
gcc/ada/prj-pars.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -80,8 +80,11 @@ package body Prj.Pars is
if Project_Node /= Empty_Node then if Project_Node /= Empty_Node then
begin begin
-- No config file should be read from the disk for gnatmake. -- No config file should be read from the disk for gnatmake.
-- However, we will simulate one that only contains the -- However, we will simulate one that only contains the default
-- default GNAT naming scheme. -- GNAT naming scheme.
-- We pass an invalid config_file_name, to prevent reading a
-- default.cgpr that might happen to be in the current directory.
Process_Project_And_Apply_Config Process_Project_And_Apply_Config
(Main_Project => The_Project, (Main_Project => The_Project,

3
gcc/ada/sem.adb
View File

@ -530,9 +530,6 @@ package body Sem is
when N_Subprogram_Declaration => when N_Subprogram_Declaration =>
Analyze_Subprogram_Declaration (N); Analyze_Subprogram_Declaration (N);
when N_Subprogram_Info =>
Analyze_Subprogram_Info (N);
when N_Subprogram_Renaming_Declaration => when N_Subprogram_Renaming_Declaration =>
Analyze_Subprogram_Renaming (N); Analyze_Subprogram_Renaming (N);

9
gcc/ada/sem_ch11.adb
View File

@ -737,13 +737,4 @@ package body Sem_Ch11 is
end if; end if;
end Analyze_Raise_xxx_Error; end Analyze_Raise_xxx_Error;
-----------------------------
-- Analyze_Subprogram_Info --
-----------------------------
procedure Analyze_Subprogram_Info (N : Node_Id) is
begin
Set_Etype (N, RTE (RE_Code_Loc));
end Analyze_Subprogram_Info;
end Sem_Ch11; end Sem_Ch11;

1
gcc/ada/sem_ch11.ads
View File

@ -30,7 +30,6 @@ package Sem_Ch11 is
procedure Analyze_Raise_Expression (N : Node_Id); procedure Analyze_Raise_Expression (N : Node_Id);
procedure Analyze_Raise_Statement (N : Node_Id); procedure Analyze_Raise_Statement (N : Node_Id);
procedure Analyze_Raise_xxx_Error (N : Node_Id); procedure Analyze_Raise_xxx_Error (N : Node_Id);
procedure Analyze_Subprogram_Info (N : Node_Id);
procedure Analyze_Exception_Handlers (L : List_Id); procedure Analyze_Exception_Handlers (L : List_Id);
-- Analyze list of exception handlers of a handled statement sequence -- Analyze list of exception handlers of a handled statement sequence

14
gcc/ada/sem_ch3.adb
View File

@ -2378,10 +2378,22 @@ package body Sem_Ch3 is
-- This ensures that the primitive will override its inherited -- This ensures that the primitive will override its inherited
-- counterpart before the freeze takes place. -- counterpart before the freeze takes place.
-- If the declaration we just processed is a body, do not attempt
-- to examine Next_Decl as the late primitive idiom can only apply
-- to the first encountered body.
-- The spec of the late primitive is not generated in ASIS mode to
-- ensure a consistent list of primitives that indicates the true
-- semantic structure of the program (which is not relevant when
-- generating executable code.
-- ??? a cleaner approach may be possible and/or this solution -- ??? a cleaner approach may be possible and/or this solution
-- could be extended to general-purpose late primitives, TBD. -- could be extended to general-purpose late primitives, TBD.
if not Body_Seen and then not Is_Body (Decl) then if not ASIS_Mode
and then not Body_Seen
and then not Is_Body (Decl)
then
Body_Seen := True; Body_Seen := True;
if Nkind (Next_Decl) = N_Subprogram_Body then if Nkind (Next_Decl) = N_Subprogram_Body then

13
gcc/ada/sem_res.adb
View File

@ -201,7 +201,6 @@ package body Sem_Res is
procedure Resolve_Short_Circuit (N : Node_Id; Typ : Entity_Id); procedure Resolve_Short_Circuit (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id); procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id);
procedure Resolve_String_Literal (N : Node_Id; Typ : Entity_Id); procedure Resolve_String_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Subprogram_Info (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id); procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Unary_Op (N : Node_Id; Typ : Entity_Id); procedure Resolve_Unary_Op (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Unchecked_Expression (N : Node_Id; Typ : Entity_Id); procedure Resolve_Unchecked_Expression (N : Node_Id; Typ : Entity_Id);
@ -2897,9 +2896,6 @@ package body Sem_Res is
when N_String_Literal when N_String_Literal
=> Resolve_String_Literal (N, Ctx_Type); => Resolve_String_Literal (N, Ctx_Type);
when N_Subprogram_Info
=> Resolve_Subprogram_Info (N, Ctx_Type);
when N_Type_Conversion when N_Type_Conversion
=> Resolve_Type_Conversion (N, Ctx_Type); => Resolve_Type_Conversion (N, Ctx_Type);
@ -9780,15 +9776,6 @@ package body Sem_Res is
end; end;
end Resolve_String_Literal; end Resolve_String_Literal;
-----------------------------
-- Resolve_Subprogram_Info --
-----------------------------
procedure Resolve_Subprogram_Info (N : Node_Id; Typ : Entity_Id) is
begin
Set_Etype (N, Typ);
end Resolve_Subprogram_Info;
----------------------------- -----------------------------
-- Resolve_Type_Conversion -- -- Resolve_Type_Conversion --
----------------------------- -----------------------------

32
gcc/ada/sem_util.adb
View File

@ -13344,7 +13344,6 @@ package body Sem_Util is
Exp := N; Exp := N;
loop loop
<<Continue>>
Ent := Empty; Ent := Empty;
if Is_Entity_Name (Exp) then if Is_Entity_Name (Exp) then
@ -13370,8 +13369,7 @@ package body Sem_Util is
end if; end if;
if Nkind (P) = N_Selected_Component if Nkind (P) = N_Selected_Component
and then and then Present (Entry_Formal (Entity (Selector_Name (P))))
Present (Entry_Formal (Entity (Selector_Name (P))))
then then
-- Case of a reference to an entry formal -- Case of a reference to an entry formal
@ -13380,8 +13378,8 @@ package body Sem_Util is
elsif Nkind (P) = N_Identifier elsif Nkind (P) = N_Identifier
and then Nkind (Parent (Entity (P))) = N_Object_Declaration and then Nkind (Parent (Entity (P))) = N_Object_Declaration
and then Present (Expression (Parent (Entity (P)))) and then Present (Expression (Parent (Entity (P))))
and then Nkind (Expression (Parent (Entity (P)))) and then Nkind (Expression (Parent (Entity (P)))) =
= N_Reference N_Reference
then then
-- Case of a reference to a value on which side effects have -- Case of a reference to a value on which side effects have
-- been removed. -- been removed.
@ -13391,7 +13389,6 @@ package body Sem_Util is
else else
return; return;
end if; end if;
end; end;
@ -13405,8 +13402,24 @@ package body Sem_Util is
N_Indexed_Component, N_Indexed_Component,
N_Selected_Component) N_Selected_Component)
then then
Exp := Prefix (Exp); -- Special check, if the prefix is an access type, then return
goto Continue; -- since we are modifying the thing pointed to, not the prefix.
-- When we are expanding, most usually the prefix is replaced
-- by an explicit dereference, and this test is not needed, but
-- in some cases (notably -gnatc mode and generics) when we do
-- not do full expansion, we need this special test.
if Is_Access_Type (Etype (Prefix (Exp))) then
return;
-- Otherwise go to prefix and keep going
else
Exp := Prefix (Exp);
goto Continue;
end if;
-- All other cases, not a modification
else else
return; return;
@ -13539,6 +13552,9 @@ package body Sem_Util is
return; return;
end if; end if;
<<Continue>>
null;
end loop; end loop;
end Note_Possible_Modification; end Note_Possible_Modification;

6
gcc/ada/sinfo.adb
View File

@ -1627,8 +1627,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Enumeration_Representation_Clause or else NT (N).Nkind = N_Enumeration_Representation_Clause
or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Label
or else NT (N).Nkind = N_Loop_Statement or else NT (N).Nkind = N_Loop_Statement
or else NT (N).Nkind = N_Record_Representation_Clause or else NT (N).Nkind = N_Record_Representation_Clause);
or else NT (N).Nkind = N_Subprogram_Info);
return Node1 (N); return Node1 (N);
end Identifier; end Identifier;
@ -4768,8 +4767,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Enumeration_Representation_Clause or else NT (N).Nkind = N_Enumeration_Representation_Clause
or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Label
or else NT (N).Nkind = N_Loop_Statement or else NT (N).Nkind = N_Loop_Statement
or else NT (N).Nkind = N_Record_Representation_Clause or else NT (N).Nkind = N_Record_Representation_Clause);
or else NT (N).Nkind = N_Subprogram_Info);
Set_Node1_With_Parent (N, Val); Set_Node1_With_Parent (N, Val);
end Set_Identifier; end Set_Identifier;

25
gcc/ada/sinfo.ads
View File

@ -7683,23 +7683,6 @@ package Sinfo is
-- with the N_In node (or a rewriting thereof) corresponding to a -- with the N_In node (or a rewriting thereof) corresponding to a
-- classwide membership test. -- classwide membership test.
---------------------
-- Subprogram_Info --
---------------------
-- This node generates the appropriate Subprogram_Info value for a
-- given procedure. See Ada.Exceptions for further details
-- Sprint syntax: subprog'subprogram_info
-- N_Subprogram_Info
-- Sloc points to the entity for the procedure
-- Identifier (Node1) identifier referencing the procedure
-- Etype (Node5-Sem) type (always set to Ada.Exceptions.Code_Loc)
-- Note: in the case where a debug source file is generated, the Sloc
-- for this node points to the quote in the Sprint file output.
-------------------------- --------------------------
-- Unchecked Expression -- -- Unchecked Expression --
-------------------------- --------------------------
@ -7977,7 +7960,6 @@ package Sinfo is
N_Reference, N_Reference,
N_Selected_Component, N_Selected_Component,
N_Slice, N_Slice,
N_Subprogram_Info,
N_Type_Conversion, N_Type_Conversion,
N_Unchecked_Expression, N_Unchecked_Expression,
N_Unchecked_Type_Conversion, N_Unchecked_Type_Conversion,
@ -12080,13 +12062,6 @@ package Sinfo is
4 => False, -- unused 4 => False, -- unused
5 => False), -- Etype (Node5-Sem) 5 => False), -- Etype (Node5-Sem)
N_Subprogram_Info =>
(1 => True, -- Identifier (Node1)
2 => False, -- unused
3 => False, -- unused
4 => False, -- unused
5 => False), -- Etype (Node5-Sem)
N_Unchecked_Expression => N_Unchecked_Expression =>
(1 => False, -- unused (1 => False, -- unused
2 => False, -- unused 2 => False, -- unused

4
gcc/ada/sprint.adb
View File

@ -3091,10 +3091,6 @@ package body Sprint is
Write_Char (';'); Write_Char (';');
when N_Subprogram_Info =>
Sprint_Node (Identifier (Node));
Write_Str_With_Col_Check_Sloc ("'subprogram_info");
when N_Subprogram_Renaming_Declaration => when N_Subprogram_Renaming_Declaration =>
Write_Indent; Write_Indent;
Sprint_Node (Specification (Node)); Sprint_Node (Specification (Node));

1
gcc/ada/sprint.ads
View File

@ -81,7 +81,6 @@ package Sprint is
-- Reference expression'reference -- Reference expression'reference
-- Shift nodes shift_name!(expr, count) -- Shift nodes shift_name!(expr, count)
-- Static declaration name : static xxx -- Static declaration name : static xxx
-- Subprogram_Info subprog'Subprogram_Info
-- Unchecked conversion target_type!(source_expression) -- Unchecked conversion target_type!(source_expression)
-- Unchecked expression `(expression) -- Unchecked expression `(expression)
-- Validate_Unchecked_Conversion validate unchecked_conversion -- Validate_Unchecked_Conversion validate unchecked_conversion