Skip to content

R
riscv-gcc-1
Commit 0eb4c1a7 by Arnaud Charlet
Options

[multiple changes] 

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
	sequence of statements.

2010-10-07  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (Check_Files): Only add a .ci files if it exists

2010-10-07  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Type_Is_Abstract): New subprogram.
	* rtsfind.ads (RE_Type_Is_Abstract): New entity.
	* exp_disp.adb (Make_DT): Initialize TSD component Type_Is_Abstract.

2010-10-07  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch12.adb (Mark_Context): Removed, no longer needed.
	(Analyze_Package_Instantiation): No longer analyze systematically a
	generic body in CodePeer mode.
	* freeze.adb, sem_attr.adb: Update comments.

From-SVN: r165081
parent b607a144
Showing with 110 additions and 152 deletions
gcc/ada/ChangeLog
2010-10-07 Ed Schonberg <schonberg@adacore.com>
* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
sequence of statements.
2010-10-07 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (Check_Files): Only add a .ci files if it exists
2010-10-07 Javier Miranda <miranda@adacore.com>
* a-tags.ads, a-tags.adb (Type_Is_Abstract): New subprogram.
* rtsfind.ads (RE_Type_Is_Abstract): New entity.
* exp_disp.adb (Make_DT): Initialize TSD component Type_Is_Abstract.
2010-10-07 Arnaud Charlet <charlet@adacore.com>
* sem_ch12.adb (Mark_Context): Removed, no longer needed.
(Analyze_Package_Instantiation): No longer analyze systematically a
generic body in CodePeer mode.
* freeze.adb, sem_attr.adb: Update comments.
2010-10-05 Robert Dewar <dewar@adacore.com>
* par-ch5.adb (Test_Statement_Required): Allow all pragmas in Ada 2012
......
gcc/ada/a-tags.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -949,6 +949,24 @@ package body Ada.Tags is
SSD (T).SSD_Table (Position).Kind := Value;
end Set_Prim_Op_Kind;
----------------------
-- Type_Is_Abstract --
----------------------
function Type_Is_Abstract (T : Tag) return Boolean is
TSD_Ptr : Addr_Ptr;
TSD : Type_Specific_Data_Ptr;
begin
if T = No_Tag then
raise Tag_Error;
end if;
TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD := To_Type_Specific_Data_Ptr (TSD_Ptr.all);
return TSD.Type_Is_Abstract;
end Type_Is_Abstract;
------------------------
-- Wide_Expanded_Name --
------------------------
......
gcc/ada/a-tags.ads
......@@ -75,6 +75,9 @@ package Ada.Tags is
function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
pragma Ada_05 (Interface_Ancestor_Tags);
function Type_Is_Abstract (T : Tag) return Boolean;
pragma Ada_05 (Type_Is_Abstract);
Tag_Error : exception;
private
......@@ -103,6 +106,8 @@ private
-- +-------------------+
-- | transportable |
-- +-------------------+
-- | type_is_abstract |
-- +-------------------+
-- | rec ctrler offset |
-- +-------------------+
-- | Ifaces_Table ---> Interface Data
......@@ -280,6 +285,9 @@ private
-- for being used in remote calls as actuals for classwide formals or as
-- return values for classwide functions.
Type_Is_Abstract : Boolean;
-- True if the type is abstract (Ada 2012: AI05-0173)
RC_Offset : SSE.Storage_Offset;
-- Controller Offset: Used to give support to tagged controlled objects
-- (see Get_Deep_Controller at s-finimp)
......
gcc/ada/exp_disp.adb
......@@ -4679,6 +4679,7 @@ package body Exp_Disp is
-- External_Tag => Cstring_Ptr!(Exname'Address))
-- HT_Link => HT_Link'Address,
-- Transportable => <<boolean-value>>,
-- Type_Is_Abstract => <<boolean-value>>,
-- RC_Offset => <<integer-value>>,
-- [ Size_Func => Size_Prim'Access ]
-- [ Interfaces_Table => <<access-value>> ]
......@@ -4945,6 +4946,22 @@ package body Exp_Disp is
New_Occurrence_Of (Transportable, Loc));
end;
-- Type_Is_Abstract (Ada 2012: AI05-0173). This functionality is
-- not available in the HIE runtime.
if RTE_Record_Component_Available (RE_Type_Is_Abstract) then
declare
Type_Is_Abstract : Entity_Id;
begin
Type_Is_Abstract :=
Boolean_Literals (Is_Abstract_Type (Typ));
Append_To (TSD_Aggr_List,
New_Occurrence_Of (Type_Is_Abstract, Loc));
end;
end if;
-- RC_Offset: These are the valid values and their meaning:
-- >0: For simple types with controlled components is
......
gcc/ada/freeze.adb
......@@ -2249,7 +2249,9 @@ package body Freeze is
and then Esize (Rec) >= Scalar_Component_Total_RM_Size
-- Never do implicit packing in CodePeer mode since we don't do
-- any packing ever in this mode (why not???)
-- any packing in this mode, since this generates over-complex
-- code that confuses CodePeer, and in general, CodePeer does not
-- care about the internal representation of objects.
and then not CodePeer_Mode
then
......
gcc/ada/gnatcmd.adb
......@@ -377,6 +377,7 @@ procedure GNATCmd is
declare
Proj : Project_List;
File : String_Access;
begin
-- Gnatstack needs to add the .ci file for the binder generated
......@@ -389,7 +390,6 @@ procedure GNATCmd is
if Check_Project (Proj.Project, Project) then
declare
Main : String_List_Id;
File : String_Access;
begin
-- Include binder generated files for main programs
......@@ -541,8 +541,7 @@ procedure GNATCmd is
end if;
if not Subunit then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
File :=
new String'
(Get_Name_String
(Unit.File_Names
......@@ -551,6 +550,11 @@ procedure GNATCmd is
(Get_Name_String
(Unit.File_Names (Impl).Display_File),
"ci"));
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if;
end if;
end if;
......@@ -562,8 +566,7 @@ procedure GNATCmd is
if Check_Project
(Unit.File_Names (Spec).Project, Project)
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
File :=
new String'
(Get_Name_String
(Unit.File_Names
......@@ -572,6 +575,11 @@ procedure GNATCmd is
MLib.Fil.Ext_To
(Get_Name_String (Unit.File_Names (Spec).File),
"ci"));
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if;
end if;
end if;
......
gcc/ada/par-ch5.adb
......@@ -83,7 +83,8 @@ package body Ch5 is
-- 5.1 Sequence of Statements --
---------------------------------
-- SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT}
-- SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
-- Note: the final label is an Ada2012 addition.
-- STATEMENT ::=
-- {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
......@@ -149,6 +150,12 @@ package body Ch5 is
-- is required. It is initialized from the Sreq flag, and modified as
-- statements are scanned (a statement turns it off, and a label turns
-- it back on again since a statement must follow a label).
-- Note : this final requirement is lifted in Ada2012.
Statement_Seen : Boolean;
-- In Ada2012 a label can end a sequence of statements, but the sequence
-- cannot contain only labels. This flag is set whenever a label is
-- encountered, to enforce this rule at the end of a sequence.
Declaration_Found : Boolean := False;
-- This flag is set True if a declaration is encountered, so that the
......@@ -222,8 +229,10 @@ package body Ch5 is
if Ada_Version >= Ada_2012
and then not Is_Empty_List (Statement_List)
and then (Nkind (Last (Statement_List)) = N_Label
or else All_Pragmas)
and then
((Nkind (Last (Statement_List)) = N_Label
and then Statement_Seen)
or else All_Pragmas)
then
declare
Null_Stm : constant Node_Id :=
......@@ -233,8 +242,6 @@ package body Ch5 is
Append_To (Statement_List, Null_Stm);
end;
-- All pragmas is OK on
-- If not Ada 2012, or not special case above, give error message
else
......@@ -249,6 +256,7 @@ package body Ch5 is
begin
Statement_List := New_List;
Statement_Required := SS_Flags.Sreq;
Statement_Seen := False;
loop
Ignore (Tok_Semicolon);
......@@ -765,8 +773,15 @@ package body Ch5 is
Statement_Required := False;
-- Label starting with << which must precede real statement
-- Note: in Ada2012, the label may end the sequence.
when Tok_Less_Less =>
if Present (Last (Statement_List))
and then Nkind (Last (Statement_List)) /= N_Label
then
Statement_Seen := True;
end if;
Append_To (Statement_List, P_Label);
Statement_Required := True;
......
gcc/ada/rtsfind.ads
......@@ -600,6 +600,7 @@ package Rtsfind is
RE_Signature, -- Ada.Tags
RE_SSD, -- Ada.Tags
RE_TSD, -- Ada.Tags
RE_Type_Is_Abstract, -- Ada.Tags
RE_Type_Specific_Data, -- Ada.Tags
RE_Register_Interface_Offset, -- Ada.Tags
RE_Register_Tag, -- Ada.Tags
......@@ -1770,6 +1771,7 @@ package Rtsfind is
RE_Signature => Ada_Tags,
RE_SSD => Ada_Tags,
RE_TSD => Ada_Tags,
RE_Type_Is_Abstract => Ada_Tags,
RE_Type_Specific_Data => Ada_Tags,
RE_Register_Interface_Offset => Ada_Tags,
RE_Register_Tag => Ada_Tags,
......
gcc/ada/sem_attr.adb
......@@ -7950,10 +7950,11 @@ package body Sem_Attr is
-- been caught by the compilation of the generic unit.
-- Note that we relax this check in CodePeer mode for
-- compatibility with legacy code.
-- This seems an odd decision??? Why should codepeer mode
-- have a different notion of legality from the compiler???
-- compatibility with legacy code, since CodePeer is an
-- Ada source code analyzer, not a strict compiler.
-- ??? Note that a better approach would be to have a
-- separate switch to relax this rule, and enable this
-- switch in CodePeer mode.
elsif Attr_Id = Attribute_Access
and then not CodePeer_Mode
......
gcc/ada/sem_ch12.adb
......@@ -475,12 +475,6 @@ package body Sem_Ch12 is
-- of generic formals of a generic package declared with a box or with
-- partial parametrization.
procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id);
-- If the generic unit comes from a different unit, indicate that the
-- unit that contains the instance depends on the body that contains
-- the generic body. Used to determine a more precise dependency graph
-- for use by CodePeer.
procedure Set_Instance_Env
(Gen_Unit : Entity_Id;
Act_Unit : Entity_Id);
......@@ -3237,8 +3231,7 @@ package body Sem_Ch12 is
or else Enclosing_Body_Present
or else Present (Corresponding_Body (Gen_Decl)))
and then (Is_In_Main_Unit (N)
or else Might_Inline_Subp
or else CodePeer_Mode)
or else Might_Inline_Subp)
and then not Is_Actual_Pack
and then not Inline_Now
and then (Operating_Mode = Generate_Code
......@@ -8609,8 +8602,6 @@ package body Sem_Ch12 is
Gen_Body_Id := Corresponding_Body (Gen_Decl);
end if;
Mark_Context (Act_Decl, Gen_Decl);
-- Establish global variable for sloc adjustment and for error recovery
Instantiation_Node := Inst_Node;
......@@ -8893,7 +8884,6 @@ package body Sem_Ch12 is
if Present (Gen_Body_Id) then
Gen_Body := Unit_Declaration_Node (Gen_Body_Id);
Mark_Context (Inst_Node, Gen_Decl);
if Nkind (Gen_Body) = N_Subprogram_Body_Stub then
......@@ -10408,131 +10398,6 @@ package body Sem_Ch12 is
end if;
end Is_Generic_Formal;
------------------
-- Mark_Context --
------------------
procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
Loc : constant Source_Ptr := Sloc (Inst_Decl);
Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl);
-- Note that we use Get_Code_Unit to determine the position of the
-- instantiation, because it may itself appear within another instance
-- and we need to mark the context of the enclosing unit, not that of
-- the unit that contains the generic.
Gen_CU : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
Inst : Entity_Id;
Clause : Node_Id;
Scop : Entity_Id;
procedure Add_Implicit_With (CU : Unit_Number_Type);
-- If a generic is instantiated in the direct or indirect context of
-- the current unit, but there is no with_clause for it in the current
-- context, add a with_clause for it to indicate that the body of the
-- generic should be examined before the current unit.
procedure Add_Implicit_With (CU : Unit_Number_Type) is
Withn : constant Node_Id :=
Make_With_Clause (Loc,
Name => New_Occurrence_Of (Cunit_Entity (CU), Loc));
begin
Set_Implicit_With (Withn);
Set_Library_Unit (Withn, Cunit (CU));
Set_Withed_Body (Withn, Cunit (CU));
Prepend (Withn, Context_Items (Cunit (Inst_CU)));
end Add_Implicit_With;
begin
-- This is only relevant when compiling for CodePeer. In what follows,
-- C is the current unit containing the instance body, and G is the
-- generic unit in that instance.
if not CodePeer_Mode then
return;
end if;
-- Nothing to do if G is local.
if Inst_CU = Gen_CU then
return;
end if;
-- If G is itself declared within an instance, indicate that the
-- generic body of that instance is also needed by C. This must be
-- done recursively.
Scop := Scope (Defining_Entity (Gen_Decl));
while Is_Generic_Instance (Scop)
and then Ekind (Scop) = E_Package
loop
Mark_Context
(Inst_Decl,
Unit_Declaration_Node
(Generic_Parent
(Specification (Unit_Declaration_Node (Scop)))));
Scop := Scope (Scop);
end loop;
-- Add references to other generic units in the context of G, because
-- they may be instantiated within G, and their bodies needed by C.
Clause := First (Context_Items (Cunit (Gen_CU)));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause
and then
Nkind (Unit (Library_Unit (Clause)))
= N_Generic_Package_Declaration
then
Add_Implicit_With (Get_Source_Unit (Library_Unit (Clause)));
end if;
Next (Clause);
end loop;
-- Now indicate that the body of G is needed by C
Clause := First (Context_Items (Cunit (Inst_CU)));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause
and then Library_Unit (Clause) = Cunit (Gen_CU)
then
Set_Withed_Body (Clause, Cunit (Gen_CU));
return;
end if;
Next (Clause);
end loop;
-- If the with-clause for G is not in the context of C, it may appear in
-- some ancestor of C.
Inst := Cunit_Entity (Inst_CU);
while Is_Child_Unit (Inst) loop
Inst := Scope (Inst);
Clause :=
First (Context_Items (Parent (Unit_Declaration_Node (Inst))));
while Present (Clause) loop
if Nkind (Clause) = N_With_Clause
and then Library_Unit (Clause) = Cunit (Gen_CU)
then
Set_Withed_Body (Clause, Cunit (Gen_CU));
return;
end if;
Next (Clause);
end loop;
end loop;
-- If not found, G comes from an instance elsewhere in the context. Make
-- the dependence explicit in the context of C.
Add_Implicit_With (Gen_CU);
end Mark_Context;
---------------------
-- Is_In_Main_Unit --
---------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment