Skip to content

R
riscv-gcc-1
Commit e9437007 by Javier Miranda Committed by Arnaud Charlet
Options

lib-load.ads, [...] (Load_Unit): Addition of a new parameter that indicates if... 

2005-06-14  Javier Miranda  <miranda@adacore.com>
	    Jose Ruiz  <ruiz@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* lib-load.ads, lib-load.adb (Load_Unit): Addition of a new parameter
	that indicates if we are parsing a compilation unit found in a
	limited-with clause.
	It is use to avoid the circularity check.

	* par.ads, par.adb (Par): Addition of a new parameter to indicate if
	we are parsing a compilation unit found in a limited-with clause. This
	is use to avoid the circularity check.

	* par-load.adb (Load): Indicate Lib.Load_Unit if we are loading the
	unit as a consequence of parsing a limited-with clause. This is used
	to avoid the circularity check.

	* sem_ch10.adb: Suppress Ada 2005 unit warning if -gnatwY used
	(Analyze_Context): Limited-with clauses are now allowed
	in more compilation units.
	(Analyze_Subunit_Context, Check_Parent): Protect the frontend
	againts previously reported critical errors in context clauses
	(Install_Limited_Withed_Unit): Code cleanup plus static detection
	of two further errors: renamed subprograms and renamed packages
	are not allowed in limited with clauses.
	(Install_Siblings): Do not install private_with_clauses on the package
	declaration for a non-private child unit.
	(Re_Install_Parents): When a parent of the subunit is reinstalled,
	reset visibility of child units properly.
	(Install_Withed_Unit): When a child unit appears in a with_clause of its
	parent, it is immediately visible.

From-SVN: r101045
parent d37209bf
Showing with 154 additions and 66 deletions
gcc/ada/lib-load.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -38,6 +38,7 @@ with Osint; use Osint;
with Osint.C; use Osint.C;
with Output; use Output;
with Par;
with Restrict; use Restrict;
with Scn; use Scn;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
......@@ -236,12 +237,13 @@ package body Lib.Load is
---------------
function Load_Unit
(Load_Name : Unit_Name_Type;
Required : Boolean;
Error_Node : Node_Id;
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False) return Unit_Number_Type
(Load_Name : Unit_Name_Type;
Required : Boolean;
Error_Node : Node_Id;
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False;
From_Limited_With : Boolean := False) return Unit_Number_Type
is
Calling_Unit : Unit_Number_Type;
Uname_Actual : Unit_Name_Type;
......@@ -487,7 +489,7 @@ package body Lib.Load is
or else Acts_As_Spec (Units.Table (Unum).Cunit))
and then (Nkind (Error_Node) /= N_With_Clause
or else not Limited_Present (Error_Node))
and then not From_Limited_With
then
if Debug_Flag_L then
Write_Str (" circular dependency encountered");
......@@ -561,7 +563,8 @@ package body Lib.Load is
Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
Initialize_Scanner (Unum, Source_Index (Unum));
Discard_List (Par (Configuration_Pragmas => False));
Discard_List (Par (Configuration_Pragmas => False,
From_Limited_With => From_Limited_With));
Multiple_Unit_Index := Save_Index;
Set_Loading (Unum, False);
end;
......@@ -606,8 +609,22 @@ package body Lib.Load is
-- Generate message if unit required
if Required and then Present (Error_Node) then
if Is_Predefined_File_Name (Fname) then
-- This is a predefined library unit which is not present
-- in the run time. If a predefined unit is not available
-- it may very likely be the case that there is also pragma
-- Restriction forbidding its usage. This is typically the
-- case when building a configurable run time, where the
-- usage of certain run-time units units is restricted by
-- means of both the corresponding pragma Restriction (such
-- as No_Calendar), and by not including the unit. Hence,
-- we check whether this predefined unit is forbidden, so
-- that the message about the restriction violation is
-- generated, if needed.
Check_Restricted_Unit (Load_Name, Error_Node);
Error_Msg_Name_1 := Uname_Actual;
Error_Msg
("% is not a predefined library unit", Load_Msg_Sloc);
......
gcc/ada/lib-load.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -104,12 +104,13 @@ package Lib.Load is
-- and then closed on return.
function Load_Unit
(Load_Name : Unit_Name_Type;
Required : Boolean;
Error_Node : Node_Id;
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False) return Unit_Number_Type;
(Load_Name : Unit_Name_Type;
Required : Boolean;
Error_Node : Node_Id;
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False;
From_Limited_With : Boolean := False) return Unit_Number_Type;
-- This function loads and parses the unit specified by Load_Name (or
-- returns the unit number for the previously constructed units table
-- entry if this is not the first call for this unit). Required indicates
......@@ -147,6 +148,10 @@ package Lib.Load is
-- described in the documentation of this unit. If this parameter is
-- set to True, then Load_Name may not be the real unit name and it
-- is necessary to load parents to find the real name.
--
-- From_Limited_With is True if we are loading a unit X found in a
-- limited-with clause, or some unit in the context of X. It is used to
-- avoid the check on circular dependency (Ada 2005, AI-50217)
function Create_Dummy_Package_Unit
(With_Node : Node_Id;
......
gcc/ada/par-load.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -360,11 +360,14 @@ begin
Unum :=
Load_Unit
(Load_Name => Spec_Name,
Required => False,
Subunit => False,
Error_Node => With_Node,
Renamings => True);
(Load_Name => Spec_Name,
Required => False,
Subunit => False,
Error_Node => With_Node,
Renamings => True,
From_Limited_With => From_Limited_With
or else
Limited_Present (Context_Node));
-- If we find the unit, then set spec pointer in the N_With_Clause
-- to point to the compilation unit for the spec. Remember that
......
gcc/ada/par.adb
......@@ -50,8 +50,10 @@ with Tbuild; use Tbuild;
-- Par --
---------
function Par (Configuration_Pragmas : Boolean) return List_Id is
function Par
(Configuration_Pragmas : Boolean;
From_Limited_With : Boolean := False) return List_Id
is
Num_Library_Units : Natural := 0;
-- Count number of units parsed (relevant only in syntax check only mode,
-- since in semantics check mode only a single unit is permitted anyway)
......
gcc/ada/par.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992,1993,1994,1995 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005 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- --
......@@ -29,14 +29,18 @@
with Types; use Types;
function Par (Configuration_Pragmas : Boolean) return List_Id;
function Par
(Configuration_Pragmas : Boolean;
From_Limited_With : Boolean := False) return List_Id;
-- Top level parsing routine. There are two cases:
--
-- If Configuration_Pragmas is False, Par parses a compilation unit in the
-- current source file and sets the Cunit, Cunit_Entity and Unit_Name fields
-- of the units table entry for Current_Source_Unit. On return the parse tree
-- is complete, and decorated with any required implicit label declarations.
-- The value returned in this case is always No_List.
-- The value returned in this case is always No_List. If From_Limited_With is
-- True, we are parsing a compilation unit found in a limited-with clause (Ada
-- 2005, AI-50217)
--
-- If Configuration_Pragmas is True, Par parses a list of configuration
-- pragmas from the current source file, and returns the list of pragmas.
gcc/ada/sem_ch10.adb
......@@ -803,6 +803,7 @@ package body Sem_Ch10 is
---------------------
procedure Analyze_Context (N : Node_Id) is
Ukind : constant Node_Kind := Nkind (Unit (N));
Item : Node_Id;
begin
......@@ -872,10 +873,22 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
then
if Nkind (Unit (N)) /= N_Package_Declaration then
Error_Msg_N ("limited with_clause only allowed in"
& " package specification", Item);
-- Check the compilation unit containing the limited-with
-- clause
if Ukind /= N_Package_Declaration
and then Ukind /= N_Subprogram_Declaration
and then Ukind /= N_Subprogram_Renaming_Declaration
and then Ukind /= N_Generic_Package_Declaration
and then Ukind /= N_Generic_Package_Renaming_Declaration
and then Ukind /= N_Generic_Subprogram_Declaration
and then Ukind /= N_Generic_Procedure_Renaming_Declaration
and then Ukind /= N_Package_Instantiation
and then Ukind /= N_Package_Renaming_Declaration
and then Ukind /= N_Procedure_Instantiation
then
Error_Msg_N
("limited with_clause not allowed here", Item);
end if;
-- Skip analyzing with clause if no unit, see above
......@@ -1337,16 +1350,21 @@ package body Sem_Ch10 is
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
Unit_Name := Entity (Name (Item));
-- Protect the frontend against previous errors
-- in context clauses
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name);
Unit_Name := Scope (Unit_Name);
end loop;
if Nkind (Name (Item)) /= N_Selected_Component then
Unit_Name := Entity (Name (Item));
if not Is_Immediately_Visible (Unit_Name) then
Set_Is_Immediately_Visible (Unit_Name);
Set_Context_Installed (Item);
while Is_Child_Unit (Unit_Name) loop
Set_Is_Visible_Child_Unit (Unit_Name);
Unit_Name := Scope (Unit_Name);
end loop;
if not Is_Immediately_Visible (Unit_Name) then
Set_Is_Immediately_Visible (Unit_Name);
Set_Context_Installed (Item);
end if;
end if;
elsif Nkind (Item) = N_Use_Package_Clause then
......@@ -1376,7 +1394,13 @@ package body Sem_Ch10 is
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
if Nkind (Item) = N_With_Clause
-- Protect the frontend against previous errors in context
-- clauses
and then Nkind (Name (Item)) /= N_Selected_Component
then
Unit_Name := Entity (Name (Item));
while Is_Child_Unit (Unit_Name) loop
......@@ -1424,8 +1448,16 @@ package body Sem_Ch10 is
E := First_Entity (Current_Scope);
-- Make entities in scope visible again. For child units, restore
-- visibility only if they are actually in context.
while Present (E) loop
Set_Is_Immediately_Visible (E);
if not Is_Child_Unit (E)
or else Is_Visible_Child_Unit (E)
then
Set_Is_Immediately_Visible (E);
end if;
Next_Entity (E);
end loop;
......@@ -1708,7 +1740,10 @@ package body Sem_Ch10 is
"and version-dependent?",
Name (N));
elsif U_Kind = Ada_05_Unit and then Ada_Version = Ada_95 then
elsif U_Kind = Ada_05_Unit
and then Ada_Version < Ada_05
and then Warn_On_Ada_2005_Compatibility
then
Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
end if;
end;
......@@ -2180,7 +2215,7 @@ package body Sem_Ch10 is
From_With_Type (Scope (Entity (Selector_Name (Name (Item)))))
then
Error_Msg_Sloc := Sloc (Item);
Error_Msg_N ("Missing With_Clause for With_Type_Clause#", N);
Error_Msg_N ("missing With_Clause for With_Type_Clause#", N);
end if;
Next (Item);
......@@ -2934,6 +2969,19 @@ package body Sem_Ch10 is
begin
pragma Assert (Nkind (W) = N_With_Clause);
-- Protect the frontend against previous critical errors
case Nkind (Unit (Library_Unit (W))) is
when N_Subprogram_Declaration |
N_Package_Declaration |
N_Generic_Subprogram_Declaration |
N_Generic_Package_Declaration =>
null;
when others =>
return;
end case;
-- Step 1: Check if the unlimited view is installed in the parent
Item := First (Context_Items (P));
......@@ -3275,10 +3323,18 @@ package body Sem_Ch10 is
-- scope of each entity is an ancestor of the current unit.
Item := First (Context_Items (N));
-- Do not install private_with_clauses if the unit is a package
-- declaration, unless it is itself a private child unit.
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then not Implicit_With (Item)
and then not Limited_Present (Item)
and then
(not Private_Present (Item)
or else Nkind (Unit (N)) /= N_Package_Declaration
or else Private_Present (N))
then
Id := Entity (Name (Item));
......@@ -3373,28 +3429,12 @@ package body Sem_Ch10 is
begin
-- In case of limited with_clause on subprograms, generics, instances,
-- or generic renamings, the corresponding error was previously posted
-- and we have nothing to do here.
case Nkind (P_Unit) is
when N_Package_Declaration =>
null;
-- or renamings, the corresponding error was previously posted and we
-- have nothing to do here.
when N_Subprogram_Declaration |
N_Generic_Package_Declaration |
N_Generic_Subprogram_Declaration |
N_Package_Instantiation |
N_Function_Instantiation |
N_Procedure_Instantiation |
N_Generic_Package_Renaming_Declaration |
N_Generic_Procedure_Renaming_Declaration |
N_Generic_Function_Renaming_Declaration =>
return;
when others =>
raise Program_Error;
end case;
if Nkind (P_Unit) /= N_Package_Declaration then
return;
end if;
P := Defining_Unit_Name (Specification (P_Unit));
......@@ -3578,7 +3618,7 @@ package body Sem_Ch10 is
-- analyzing the private part of the package).
if Private_Present (With_Clause)
and then Nkind (Cunit (Current_Sem_Unit)) = N_Package_Declaration
and then Nkind (Unit (Parent (With_Clause))) = N_Package_Declaration
and then not (Private_With_OK)
then
return;
......@@ -3623,6 +3663,13 @@ package body Sem_Ch10 is
elsif not Is_Visible_Child_Unit (Uname) then
Set_Is_Visible_Child_Unit (Uname);
-- If the child unit appears in the context of its parent, it
-- is immediately visible.
if In_Open_Scopes (Scope (Uname)) then
Set_Is_Immediately_Visible (Uname);
end if;
if Is_Generic_Instance (Uname)
and then Ekind (Uname) in Subprogram_Kind
then
......@@ -4112,6 +4159,16 @@ package body Sem_Ch10 is
& "limited with_clauses", N);
return;
when N_Subprogram_Renaming_Declaration =>
Error_Msg_N ("renamed subprograms not allowed in "
& "limited with_clauses", N);
return;
when N_Package_Renaming_Declaration =>
Error_Msg_N ("renamed packages not allowed in "
& "limited with_clauses", N);
return;
when others =>
raise Program_Error;
end case;
......
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