-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Expected_Unit => Spec_Name,
Fatal_Error => True,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Loading => False,
Main_Priority => Default_Main_Priority,
+ Main_CPU => Default_Main_CPU,
Munit_Index => 0,
Serial_Number => 0,
Source_Index => No_Source_File,
Expected_Unit => No_Unit_Name,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Loading => True,
Main_Priority => Default_Main_Priority,
+ Main_CPU => Default_Main_CPU,
Munit_Index => 0,
Serial_Number => 0,
Source_Index => Main_Source_File,
Subunit : Boolean;
Corr_Body : Unit_Number_Type := No_Unit;
Renamings : Boolean := False;
- With_Node : Node_Id := Empty) return Unit_Number_Type
+ With_Node : Node_Id := Empty;
+ PMES : Boolean := False) return Unit_Number_Type
is
Calling_Unit : Unit_Number_Type;
Uname_Actual : Unit_Name_Type;
Unump : Unit_Number_Type;
Fname : File_Name_Type;
Src_Ind : Source_File_Index;
+ Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
- -- Start of processing for Load_Unit
+ Save_Cunit_Restrictions : constant Save_Cunit_Boolean_Restrictions :=
+ Cunit_Boolean_Restrictions_Save;
+ -- Save current restrictions for restore at end
begin
+ Parsing_Main_Extended_Source := PMES;
+
+ -- Initialize restrictions to config restrictions for unit to load if
+ -- it is part of the main extended source, otherwise reset them.
+
+ -- Note: it's a bit odd but PMES is False for subunits, which is why
+ -- we have the OR here. Should be investigated some time???
+
+ if PMES or Subunit then
+ Restore_Config_Cunit_Boolean_Restrictions;
+ else
+ Reset_Cunit_Boolean_Restrictions;
+ end if;
+
-- If renamings are allowed and we have a child unit name, then we
-- must first load the parent to deal with finding the real name.
-- Retain the with_clause that names the child, so that if it is
With_Node => With_Node);
if Unump = No_Unit then
+ Parsing_Main_Extended_Source := Save_PMES;
return No_Unit;
end if;
New_Child
(Load_Name, Get_Unit_Name (Name (Unit (Cunit (Unump)))));
+ -- If the load is for a with_clause, for visibility purposes both
+ -- the renamed entity and renaming one must be available in the
+ -- current unit: the renamed one in order to retrieve the child
+ -- unit, and the original one because it may be used as a prefix
+ -- in the body of the current unit. We add an explicit with_clause
+ -- for the original parent so that the renaming declaration is
+ -- properly loaded and analyzed.
+
+ if Present (With_Node) then
+ Insert_After (With_Node,
+ Make_With_Clause (Sloc (With_Node),
+ Name => Copy_Separate_Tree (Prefix (Name (With_Node)))));
+ end if;
+
-- Save the renaming entity, to establish its visibility when
-- installing the context. The implicit with is on this entity,
- -- not on the package it renames.
+ -- not on the package it renames. This is somewhat redundant given
+ -- the with_clause just created, but it simplifies subsequent
+ -- expansion of the current with_clause. Optimizable ???
if Nkind (Error_Node) = N_With_Clause
and then Nkind (Name (Error_Node)) = N_Selected_Component
-- See if we already have an entry for this unit
Unum := Main_Unit;
-
while Unum <= Units.Last loop
exit when Uname_Actual = Units.Table (Unum).Unit_Name;
Unum := Unum + 1;
end if;
Write_Dependency_Chain;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
else
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
end if;
end loop;
Load_Stack.Decrement_Last;
end if;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
if Debug_Flag_L then
end if;
Load_Stack.Decrement_Last;
- return Unum;
+ goto Done;
-- Unit is not already in table, so try to open the file
Expected_Unit => Uname_Actual,
Fatal_Error => False,
Generate_Code => False,
+ Has_Allocator => False,
Has_RACW => False,
Is_Compiler_Unit => False,
Ident_String => Empty,
Loading => True,
Main_Priority => Default_Main_Priority,
+ Main_CPU => Default_Main_CPU,
Munit_Index => 0,
Serial_Number => 0,
Source_Index => Src_Ind,
-- Parse the new unit
declare
- Save_Index : constant Nat := Multiple_Unit_Index;
+ Save_Index : constant Nat := Multiple_Unit_Index;
+ Save_PMES : constant Boolean := Parsing_Main_Extended_Source;
+
begin
Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
Initialize_Scanner (Unum, Source_Index (Unum));
+
+ if Calling_Unit = Main_Unit and then Subunit then
+ Parsing_Main_Extended_Source := True;
+ end if;
+
Discard_List (Par (Configuration_Pragmas => False));
+
+ Parsing_Main_Extended_Source := Save_PMES;
+
Multiple_Unit_Index := Save_Index;
Set_Loading (Unum, False);
end;
Error_Msg
("\incorrect spec in file { must be removed first!",
Load_Msg_Sloc);
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
-- If loaded unit had a fatal error, then caller inherits it!
-- All done, return unit number
- return Unum;
+ goto Done;
-- Case of file not found
Units.Decrement_Last;
end if;
- return No_Unit;
+ Unum := No_Unit;
+ goto Done;
end if;
end if;
+
+ -- Here to exit, with result in Unum
+
+ <<Done>>
+ Parsing_Main_Extended_Source := Save_PMES;
+ Cunit_Boolean_Restrictions_Restore (Save_Cunit_Restrictions);
+ return Unum;
end Load_Unit;
--------------------------
OSDN Git Service
