[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

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>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram

View File

@ -1882,27 +1882,6 @@ package body Exp_Ch11 is
end;
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 --
------------------------

View File

@ -35,7 +35,6 @@ package Exp_Ch11 is
procedure Expand_N_Raise_Program_Error (N : Node_Id);
procedure Expand_N_Raise_Statement (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
-- See runtime routine Ada.Exceptions for full details on the format and

View File

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

View File

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

View File

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

View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
begin
-- No config file should be read from the disk for gnatmake.
-- However, we will simulate one that only contains the
-- default GNAT naming scheme.
-- However, we will simulate one that only contains the default
-- 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
(Main_Project => The_Project,

View File

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

View File

@ -737,13 +737,4 @@ package body Sem_Ch11 is
end if;
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;

View File

@ -30,7 +30,6 @@ package Sem_Ch11 is
procedure Analyze_Raise_Expression (N : Node_Id);
procedure Analyze_Raise_Statement (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);
-- Analyze list of exception handlers of a handled statement sequence

View File

@ -2378,10 +2378,22 @@ package body Sem_Ch3 is
-- This ensures that the primitive will override its inherited
-- 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
-- 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;
if Nkind (Next_Decl) = N_Subprogram_Body then

View File

@ -201,7 +201,6 @@ package body Sem_Res is
procedure Resolve_Short_Circuit (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_Subprogram_Info (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_Unchecked_Expression (N : Node_Id; Typ : Entity_Id);
@ -2897,9 +2896,6 @@ package body Sem_Res is
when N_String_Literal
=> Resolve_String_Literal (N, Ctx_Type);
when N_Subprogram_Info
=> Resolve_Subprogram_Info (N, Ctx_Type);
when N_Type_Conversion
=> Resolve_Type_Conversion (N, Ctx_Type);
@ -9780,15 +9776,6 @@ package body Sem_Res is
end;
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 --
-----------------------------

View File

@ -13344,7 +13344,6 @@ package body Sem_Util is
Exp := N;
loop
<<Continue>>
Ent := Empty;
if Is_Entity_Name (Exp) then
@ -13370,8 +13369,7 @@ package body Sem_Util is
end if;
if Nkind (P) = N_Selected_Component
and then
Present (Entry_Formal (Entity (Selector_Name (P))))
and then Present (Entry_Formal (Entity (Selector_Name (P))))
then
-- Case of a reference to an entry formal
@ -13380,8 +13378,8 @@ package body Sem_Util is
elsif Nkind (P) = N_Identifier
and then Nkind (Parent (Entity (P))) = N_Object_Declaration
and then Present (Expression (Parent (Entity (P))))
and then Nkind (Expression (Parent (Entity (P))))
= N_Reference
and then Nkind (Expression (Parent (Entity (P)))) =
N_Reference
then
-- Case of a reference to a value on which side effects have
-- been removed.
@ -13391,7 +13389,6 @@ package body Sem_Util is
else
return;
end if;
end;
@ -13405,8 +13402,24 @@ package body Sem_Util is
N_Indexed_Component,
N_Selected_Component)
then
Exp := Prefix (Exp);
goto Continue;
-- Special check, if the prefix is an access type, then return
-- 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
return;
@ -13539,6 +13552,9 @@ package body Sem_Util is
return;
end if;
<<Continue>>
null;
end loop;
end Note_Possible_Modification;

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_Label
or else NT (N).Nkind = N_Loop_Statement
or else NT (N).Nkind = N_Record_Representation_Clause
or else NT (N).Nkind = N_Subprogram_Info);
or else NT (N).Nkind = N_Record_Representation_Clause);
return Node1 (N);
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_Label
or else NT (N).Nkind = N_Loop_Statement
or else NT (N).Nkind = N_Record_Representation_Clause
or else NT (N).Nkind = N_Subprogram_Info);
or else NT (N).Nkind = N_Record_Representation_Clause);
Set_Node1_With_Parent (N, Val);
end Set_Identifier;

View File

@ -7683,23 +7683,6 @@ package Sinfo is
-- with the N_In node (or a rewriting thereof) corresponding to a
-- 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 --
--------------------------
@ -7977,7 +7960,6 @@ package Sinfo is
N_Reference,
N_Selected_Component,
N_Slice,
N_Subprogram_Info,
N_Type_Conversion,
N_Unchecked_Expression,
N_Unchecked_Type_Conversion,
@ -12080,13 +12062,6 @@ package Sinfo is
4 => False, -- unused
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 =>
(1 => False, -- unused
2 => False, -- unused

View File

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

View File

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