mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 01:20:52 +08:00
[multiple changes]
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. From-SVN: r164157
This commit is contained in:
Arnaud Charlet
parent
4120ada717
commit
3c1ecd7e8a
@ -1,3 +1,34 @@
|
||||
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,
|
||||
|
||||
@ -2341,7 +2341,7 @@ package body Bindgen is
|
||||
|
||||
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"");");
|
||||
@ -2750,7 +2750,7 @@ package body Bindgen is
|
||||
|
||||
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[] = """);
|
||||
|
||||
@ -1481,12 +1481,8 @@ package body Exp_Ch3 is
|
||||
|
||||
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;
|
||||
@ -2042,10 +2038,8 @@ package body Exp_Ch3 is
|
||||
|
||||
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;
|
||||
|
||||
@ -3724,8 +3724,8 @@ package body Exp_Ch4 is
|
||||
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
|
||||
|
||||
@ -12133,13 +12133,14 @@ package body Exp_Ch9 is
|
||||
|
||||
-- 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;
|
||||
|
||||
|
||||
@ -6667,8 +6667,8 @@ package body Exp_Disp is
|
||||
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);
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -42,7 +42,8 @@ package body GNAT.Compiler_Version is
|
||||
-- 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");
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -77,6 +77,10 @@ package Gnatvsn is
|
||||
-- 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
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -1396,6 +1396,11 @@ package Rtsfind is
|
||||
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
|
||||
@ -2561,6 +2566,11 @@ package Rtsfind is
|
||||
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,
|
||||
|
||||
115
gcc/ada/sem.adb
115
gcc/ada/sem.adb
@ -1539,6 +1539,23 @@ package body Sem is
|
||||
-- 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
|
||||
|
||||
@ -1558,6 +1575,39 @@ package body Sem is
|
||||
-- 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 --
|
||||
---------------
|
||||
@ -1812,45 +1862,6 @@ package body Sem is
|
||||
|
||||
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
|
||||
@ -1931,8 +1942,9 @@ package body Sem is
|
||||
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);
|
||||
@ -1969,10 +1981,26 @@ package body Sem is
|
||||
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;
|
||||
|
||||
@ -2042,6 +2070,7 @@ package body Sem is
|
||||
|
||||
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;
|
||||
|
||||
@ -8287,7 +8287,13 @@ package body Sem_Prag is
|
||||
|
||||
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 --
|
||||
|
||||
@ -9302,8 +9302,8 @@ package body Sem_Res is
|
||||
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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user