+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
-- --
-- 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- --
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 --
------------------------
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
-- +-------------------+
-- | transportable |
-- +-------------------+
+ -- | type_is_abstract |
+ -- +-------------------+
-- | rec ctrler offset |
-- +-------------------+
-- | Ifaces_Table ---> Interface Data
-- 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)
-- 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>> ]
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
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
declare
Proj : Project_List;
+ File : String_Access;
begin
-- Gnatstack needs to add the .ci file for the binder generated
if Check_Project (Proj.Project, Project) then
declare
Main : String_List_Id;
- File : String_Access;
begin
-- Include binder generated files for main programs
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
(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;
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
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;
-- 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
-- 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
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 :=
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
begin
Statement_List := New_List;
Statement_Required := SS_Flags.Sreq;
+ Statement_Seen := False;
loop
Ignore (Tok_Semicolon);
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;
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
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,
-- 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
-- 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);
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
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;
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
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 --
---------------------
OSDN Git Service
