+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
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 --
------------------------
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
N_Single_Protected_Declaration |
N_Slice |
N_String_Literal |
- N_Subprogram_Info |
N_Subtype_Indication |
N_Subunit |
N_Task_Definition |
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);
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,
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,
-- --
-- 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- --
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,
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);
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;
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
-- 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
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);
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);
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 --
-----------------------------
Exp := N;
loop
- <<Continue>>
Ent := Empty;
if Is_Entity_Name (Exp) then
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
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.
else
return;
-
end if;
end;
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;
return;
end if;
+
+ <<Continue>>
+ null;
end loop;
end Note_Possible_Modification;
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;
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;
-- 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 --
--------------------------
N_Reference,
N_Selected_Component,
N_Slice,
- N_Subprogram_Info,
N_Type_Conversion,
N_Unchecked_Expression,
N_Unchecked_Type_Conversion,
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
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));
-- 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
projects / thirdparty / gcc.git / commitdiff
