* exp_disp.adb: Minor reformatting.
2010-09-10 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
CodePeer mode.
2010-09-10 Thomas Quinot <quinot@adacore.com>
* sem_res.adb: Minor reformatting.
* exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
magic constants for task master levels (instead, reference
named numbers from System.Tasking).
2010-09-10 Eric Botcazou <ebotcazou@adacore.com>
* gnatvsn.ads (Ver_Prefix): New constant string.
* bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
(Gen_Output_File_C): Likewise.
* g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
in comment.
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* sem.adb (Walk_Library_Items): Do not traverse children of the main
unit, to prevent spurious circularities in the walk order.
(Depends_On_Main): Use elsewhere to prevent circularities when the body
of an ancestor of the main unit depends on a child of the main unit.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164157
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-09-10 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_disp.adb: Minor reformatting.
+
+2010-09-10 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Ignore Inline_Always pragma in
+ CodePeer mode.
+
+2010-09-10 Thomas Quinot <quinot@adacore.com>
+
+ * sem_res.adb: Minor reformatting.
+ * exp_ch9.adb, rtsfind.ads, exp_ch4.adb, exp_ch3.adb: Do not hardcode
+ magic constants for task master levels (instead, reference
+ named numbers from System.Tasking).
+
+2010-09-10 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnatvsn.ads (Ver_Prefix): New constant string.
+ * bindgen.adb (Gen_Output_File_Ada): Use it in lieu of hardcoded value.
+ (Gen_Output_File_C): Likewise.
+ * g-comver.adb (Ver_Prefix): Add cross-reference to Gnatvsn.Ver_Prefix
+ in comment.
+
+2010-09-10 Ed Schonberg <schonberg@adacore.com>
+
+ * sem.adb (Walk_Library_Items): Do not traverse children of the main
+ unit, to prevent spurious circularities in the walk order.
+ (Depends_On_Main): Use elsewhere to prevent circularities when the body
+ of an ancestor of the main unit depends on a child of the main unit.
+
2010-09-10 Robert Dewar <dewar@adacore.com>
* gnatlink.adb, prj-ext.adb, prj-util.adb, s-tporft.adb,
WBI ("");
WBI (" GNAT_Version : constant String :=");
- WBI (" ""GNAT Version: " &
+ WBI (" """ & Ver_Prefix &
Gnat_Version_String &
""" & ASCII.NUL;");
WBI (" pragma Export (C, GNAT_Version, ""__gnat_version"");");
if Bind_Main_Program then
WBI ("");
- WBI ("char __gnat_version[] = ""GNAT Version: " &
+ WBI ("char __gnat_version[] = """ & Ver_Prefix &
Gnat_Version_String & """;");
Set_String ("char __gnat_ada_main_program_name[] = """);
if Has_Task (Full_Type) then
if Restriction_Active (No_Task_Hierarchy) then
-
- -- 3 is System.Tasking.Library_Task_Level
- -- (should be rtsfindable constant ???)
-
- Append_To (Args, Make_Integer_Literal (Loc, 3));
-
+ Append_To (Args,
+ New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
end if;
if Has_Task (Rec_Type) then
if Restriction_Active (No_Task_Hierarchy) then
-
- -- 3 is System.Tasking.Library_Task_Level
-
- Append_To (Args, Make_Integer_Literal (Loc, 3));
+ Append_To (Args,
+ New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
end if;
end if;
if Restriction_Active (No_Task_Hierarchy) then
- -- 3 is System.Tasking.Library_Task_Level
- Append_To (Args, Make_Integer_Literal (Loc, 3));
+ Append_To (Args,
+ New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
else
Append_To (Args,
New_Reference_To
-- Master parameter. This is a reference to the _Master parameter of
-- the initialization procedure, except in the case of the pragma
- -- Restrictions (No_Task_Hierarchy) where the value is fixed to 3
- -- (3 is System.Tasking.Library_Task_Level).
+ -- Restrictions (No_Task_Hierarchy) where the value is fixed to
+ -- System.Tasking.Library_Task_Level.
if Restriction_Active (No_Task_Hierarchy) = False then
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
else
- Append_To (Args, Make_Integer_Literal (Loc, 3));
+ Append_To (Args,
+ New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc));
end if;
end if;
end;
end if;
- -- Mark entities of dispatch table. Required by the back end to
- -- handle them properly.
+ -- Mark entities of dispatch table. Required by the back end to handle
+ -- them properly.
if Present (DT) then
Set_Is_Dispatch_Table_Entity (DT);
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2002-2010, AdaCore --
-- --
-- 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- --
-- import this directly since run-time units cannot WITH compiler units.
Ver_Prefix : constant String := "GNAT Version: ";
- -- Prefix generated by binder
+ -- This is logically a reference to Gnatvsn.Ver_Prefix but we cannot
+ -- import this directly since run-time units cannot WITH compiler units.
GNAT_Version : constant String (1 .. Ver_Len_Max + Ver_Prefix'Length);
pragma Import (C, GNAT_Version, "__gnat_version");
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010 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- --
-- value should never be decreased in the future, but it would be
-- OK to increase it if absolutely necessary.
+ Ver_Prefix : constant String := "GNAT Version: ";
+ -- Prefix generated by binder. If it is changed, be sure to change
+ -- GNAT.Compiler_Version.Ver_Prefix as well.
+
Library_Version : constant String := "4.6";
-- Library version. This value must be updated whenever any change to the
-- compiler affects the library formats in such a way as to obsolete
-- --
-- S p e c --
-- --
--- 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- --
RE_Conditional_Call, -- System.Tasking
RE_Asynchronous_Call, -- System.Tasking
+ RE_Foreign_Task_Level, -- System.Tasking
+ RE_Environment_Task_Level, -- System.Tasking
+ RE_Independent_Task_Level, -- System.Tasking
+ RE_Library_Task_Level, -- System.Tasking
+
RE_Ada_Task_Control_Block, -- System.Tasking
RE_Task_List, -- System.Tasking
RE_Conditional_Call => System_Tasking,
RE_Asynchronous_Call => System_Tasking,
+ RE_Foreign_Task_Level => System_Tasking,
+ RE_Environment_Task_Level => System_Tasking,
+ RE_Independent_Task_Level => System_Tasking,
+ RE_Library_Task_Level => System_Tasking,
+
RE_Ada_Task_Control_Block => System_Tasking,
RE_Task_List => System_Tasking,
-- context of some other unit. We do not want this to force processing
-- of the main body before all other units have been processed.
+ function Depends_On_Main (CU : Node_Id) return Boolean;
+ -- The body of a unit that is withed by the spec of the main unit
+ -- may in turn have a with_clause on that spec. In that case do not
+ -- traverse the body, to prevent loops. It can also happen that the
+ -- main body has a with_clause on a child, which of course has an
+ -- implicit with on its parent. It's OK to traverse the child body
+ -- if the main spec has been processed, otherwise we also have a
+ -- circularity to avoid.
+
+ -- Another circularity pattern occurs when the main unit is a child unit
+ -- and the body of an ancestor has a with-clause of the main unit or on
+ -- one of its children. In both cases the body in question has a with-
+ -- clause on the main unit, and must be excluded from the traversal. In
+ -- some convoluted cases this may lead to a CodePeer error because the
+ -- spec of a subprogram declared in an instance within the parent will
+ -- not be seen in the main unit.
+
procedure Do_Action (CU : Node_Id; Item : Node_Id);
-- Calls Action, with some validity checks
-- is processed wherever it appears in the list of units, while the body
-- is processed as the last unit in the list.
+ ---------------------
+ -- Depends_On_Main --
+ ---------------------
+
+ function Depends_On_Main (CU : Node_Id) return Boolean is
+ CL : Node_Id;
+ MCU : constant Node_Id := Unit (Main_CU);
+
+ begin
+ CL := First (Context_Items (CU));
+
+ -- Problem does not arise with main subprograms
+
+ if
+ not Nkind_In (MCU, N_Package_Body, N_Package_Declaration)
+ then
+ return False;
+ end if;
+
+ while Present (CL) loop
+ if Nkind (CL) = N_With_Clause
+ and then Library_Unit (CL) = Main_CU
+ and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
+ then
+ return True;
+ end if;
+
+ Next (CL);
+ end loop;
+
+ return False;
+ end Depends_On_Main;
+
---------------
-- Do_Action --
---------------
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
- function Depends_On_Main (CU : Node_Id) return Boolean;
- -- The body of a unit that is withed by the spec of the main unit
- -- may in turn have a with_clause on that spec. In that case do not
- -- traverse the body, to prevent loops. It can also happen that the
- -- main body has a with_clause on a child, which of course has an
- -- implicit with on its parent. It's OK to traverse the child body
- -- if the main spec has been processed, otherwise we also have a
- -- circularity to avoid.
-
- ---------------------
- -- Depends_On_Main --
- ---------------------
-
- function Depends_On_Main (CU : Node_Id) return Boolean is
- CL : Node_Id;
-
- begin
- CL := First (Context_Items (CU));
-
- -- Problem does not arise with main subprograms
-
- if Nkind (Unit (Main_CU)) /= N_Package_Body then
- return False;
- end if;
-
- while Present (CL) loop
- if Nkind (CL) = N_With_Clause
- and then Library_Unit (CL) = Library_Unit (Main_CU)
- and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
- then
- return True;
- end if;
-
- Next (CL);
- end loop;
-
- return False;
- end Depends_On_Main;
-
-- Start of processing for Process_Bodies_In_Context
begin
Cur := First_Elmt (Comp_Unit_List);
while Present (Cur) loop
declare
- CU : constant Node_Id := Node (Cur);
- N : constant Node_Id := Unit (CU);
+ CU : constant Node_Id := Node (Cur);
+ N : constant Node_Id := Unit (CU);
+ Par : Entity_Id;
begin
pragma Assert (Nkind (CU) = N_Compilation_Unit);
Unit (Library_Unit (Main_CU)));
end if;
- -- It's a spec, process it, and the units it depends on
+ -- It's a spec, process it, and the units it depends on,
+ -- unless it is a descendent of the main unit. This can
+ -- happen when the body of a parent depends on some other
+ -- descendent.
when others =>
- Do_Unit_And_Dependents (CU, N);
+ Par := Scope (Defining_Entity (Unit (CU)));
+
+ if Is_Child_Unit (Defining_Entity (Unit (CU))) then
+ while Present (Par)
+ and then Par /= Standard_Standard
+ and then Par /= Cunit_Entity (Main_Unit)
+ loop
+ Par := Scope (Par);
+ end loop;
+ end if;
+
+ if Par /= Cunit_Entity (Main_Unit) then
+ Do_Unit_And_Dependents (CU, N);
+ end if;
end case;
end;
if Present (Body_CU)
and then not Seen (Get_Cunit_Unit_Number (Body_CU))
+ and then not Depends_On_Main (Body_CU)
then
Body_U := Get_Cunit_Unit_Number (Body_CU);
Seen (Body_U) := True;
when Pragma_Inline_Always =>
GNAT_Pragma;
- Process_Inline (True);
+
+ -- Pragma always active unless in CodePeer mode, since this causes
+ -- walk order issues.
+
+ if not CodePeer_Mode then
+ Process_Inline (True);
+ end if;
--------------------
-- Inline_Generic --
Index_Subtype := Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
-- Take a new copy of Drange (where bounds have been rewritten to
- -- reference side-effect-vree names). Using a separate tree ensures
- -- that further expansion (e.g while rewriting a slice assignment
+ -- reference side-effect-free names). Using a separate tree ensures
+ -- that further expansion (e.g. while rewriting a slice assignment
-- into a FOR loop) does not attempt to remove side effects on the
-- bounds again (which would cause the bounds in the index subtype
-- definition to refer to temporaries before they are defined) (the
projects / platform / upstream / linaro-gcc.git / commitdiff