Commit 9b91e150 by Ed Schonberg Committed by Arnaud Charlet

sem_ch10.adb (Analyze_Compilation_Unit): if a unit in the context is a generic…

sem_ch10.adb (Analyze_Compilation_Unit): if a unit in the context is a generic subprogram that is imported...

2008-03-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_Compilation_Unit): if a unit in the context is
	a generic subprogram that is imported, do not attempt to compile
	non-existent body.

	* sem_ch12.adb (Instantiate_Subprogram_Body): if the generic is
	imported, do not generate a raise_program_error for the non-existent
	body.
	(Pre_Analyze_Actuals): If an error is detected during pre-analysis,
	perform minimal name resolution on the generic to avoid spurious
	warnings.
	(Find_Actual_Type): the designated type of the actual in a child unit
	may be declared in a parent unit without being an actual.

From-SVN: r133575
parent d767bc3a
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -387,9 +387,9 @@ package body Sem_Ch10 is ...@@ -387,9 +387,9 @@ package body Sem_Ch10 is
elsif Nkind (Cont_Item) = N_Pragma elsif Nkind (Cont_Item) = N_Pragma
and then and then
(Chars (Cont_Item) = Name_Elaborate (Pragma_Name (Cont_Item) = Name_Elaborate
or else or else
Chars (Cont_Item) = Name_Elaborate_All) Pragma_Name (Cont_Item) = Name_Elaborate_All)
and then not Used_Type_Or_Elab and then not Used_Type_Or_Elab
then then
Prag_Unit := Prag_Unit :=
...@@ -759,7 +759,7 @@ package body Sem_Ch10 is ...@@ -759,7 +759,7 @@ package body Sem_Ch10 is
Set_Acts_As_Spec (N, False); Set_Acts_As_Spec (N, False);
Set_Is_Child_Unit (Defining_Entity (Unit_Node)); Set_Is_Child_Unit (Defining_Entity (Unit_Node));
Set_Needs_Debug_Info (Defining_Entity (Unit (Lib_Unit))); Set_Debug_Info_Needed (Defining_Entity (Unit (Lib_Unit)));
Set_Comes_From_Source_Default (SCS); Set_Comes_From_Source_Default (SCS);
end; end;
end if; end if;
...@@ -910,7 +910,6 @@ package body Sem_Ch10 is ...@@ -910,7 +910,6 @@ package body Sem_Ch10 is
Add_Stub_Constructs (N); Add_Stub_Constructs (N);
end if; end if;
end if; end if;
-- Remove unit from visibility, so that environment is clean for -- Remove unit from visibility, so that environment is clean for
...@@ -1005,8 +1004,13 @@ package body Sem_Ch10 is ...@@ -1005,8 +1004,13 @@ package body Sem_Ch10 is
then then
Nam := Entity (Name (Item)); Nam := Entity (Name (Item));
-- Compile generic subprogram, unless it is intrinsic or
-- imported so no body is required, or generic package body
-- if the package spec requires a body.
if (Is_Generic_Subprogram (Nam) if (Is_Generic_Subprogram (Nam)
and then not Is_Intrinsic_Subprogram (Nam)) and then not Is_Intrinsic_Subprogram (Nam)
and then not Is_Imported (Nam))
or else (Ekind (Nam) = E_Generic_Package or else (Ekind (Nam) = E_Generic_Package
and then Unit_Requires_Body (Nam)) and then Unit_Requires_Body (Nam))
then then
...@@ -1237,7 +1241,7 @@ package body Sem_Ch10 is ...@@ -1237,7 +1241,7 @@ package body Sem_Ch10 is
Item := First (Context_Items (N)); Item := First (Context_Items (N));
while Present (Item) while Present (Item)
and then Nkind (Item) = N_Pragma and then Nkind (Item) = N_Pragma
and then Chars (Item) in Configuration_Pragma_Names and then Pragma_Name (Item) in Configuration_Pragma_Names
loop loop
Analyze (Item); Analyze (Item);
Next (Item); Next (Item);
...@@ -1732,7 +1736,6 @@ package body Sem_Ch10 is ...@@ -1732,7 +1736,6 @@ package body Sem_Ch10 is
else else
Optional_Subunit; Optional_Subunit;
end if; end if;
end Analyze_Proper_Body; end Analyze_Proper_Body;
---------------------------------- ----------------------------------
...@@ -2693,7 +2696,8 @@ package body Sem_Ch10 is ...@@ -2693,7 +2696,8 @@ package body Sem_Ch10 is
begin begin
New_Nodes_OK := New_Nodes_OK + 1; New_Nodes_OK := New_Nodes_OK + 1;
Withn := Withn :=
Make_With_Clause (Loc, Name => Build_Unit_Name (Nam)); Make_With_Clause (Loc,
Name => Build_Unit_Name (Nam));
P := Parent (Unit_Declaration_Node (Ent)); P := Parent (Unit_Declaration_Node (Ent));
Set_Library_Unit (Withn, P); Set_Library_Unit (Withn, P);
...@@ -2729,13 +2733,10 @@ package body Sem_Ch10 is ...@@ -2729,13 +2733,10 @@ package body Sem_Ch10 is
if Nkind (Unit) = N_Package_Body if Nkind (Unit) = N_Package_Body
and then Nkind (Original_Node (Unit)) = N_Package_Instantiation and then Nkind (Original_Node (Unit)) = N_Package_Instantiation
then then
return return Defining_Entity
Defining_Entity
(Specification (Instance_Spec (Original_Node (Unit)))); (Specification (Instance_Spec (Original_Node (Unit))));
elsif Nkind (Unit) = N_Package_Instantiation then elsif Nkind (Unit) = N_Package_Instantiation then
return Defining_Entity (Specification (Instance_Spec (Unit))); return Defining_Entity (Specification (Instance_Spec (Unit)));
else else
return Defining_Entity (Unit); return Defining_Entity (Unit);
end if; end if;
...@@ -2890,7 +2891,6 @@ package body Sem_Ch10 is ...@@ -2890,7 +2891,6 @@ package body Sem_Ch10 is
end if; end if;
Install_Limited_Context_Clauses (N); Install_Limited_Context_Clauses (N);
end Install_Context; end Install_Context;
----------------------------- -----------------------------
...@@ -2913,7 +2913,7 @@ package body Sem_Ch10 is ...@@ -2913,7 +2913,7 @@ package body Sem_Ch10 is
Item := First (Context_Items (N)); Item := First (Context_Items (N));
while Present (Item) while Present (Item)
and then Nkind (Item) = N_Pragma and then Nkind (Item) = N_Pragma
and then Chars (Item) in Configuration_Pragma_Names and then Pragma_Name (Item) in Configuration_Pragma_Names
loop loop
Next (Item); Next (Item);
end loop; end loop;
...@@ -3713,6 +3713,7 @@ package body Sem_Ch10 is ...@@ -3713,6 +3713,7 @@ package body Sem_Ch10 is
Item : Node_Id; Item : Node_Id;
Id : Entity_Id; Id : Entity_Id;
Prev : Entity_Id; Prev : Entity_Id;
begin begin
-- Iterate over explicit with clauses, and check whether the scope of -- Iterate over explicit with clauses, and check whether the scope of
-- each entity is an ancestor of the current unit, in which case it is -- each entity is an ancestor of the current unit, in which case it is
...@@ -3950,8 +3951,8 @@ package body Sem_Ch10 is ...@@ -3950,8 +3951,8 @@ package body Sem_Ch10 is
while Present (Item) loop while Present (Item) loop
if Nkind (Item) = N_With_Clause if Nkind (Item) = N_With_Clause
and then not Limited_Present (Item) and then not Limited_Present (Item)
and then Nkind (Unit (Library_Unit (Item))) and then Nkind (Unit (Library_Unit (Item))) =
= N_Package_Declaration N_Package_Declaration
then then
Decl := Decl :=
First (Visible_Declarations First (Visible_Declarations
...@@ -4805,8 +4806,8 @@ package body Sem_Ch10 is ...@@ -4805,8 +4806,8 @@ package body Sem_Ch10 is
Set_Non_Limited_View (Lim_Typ, Comp_Typ); Set_Non_Limited_View (Lim_Typ, Comp_Typ);
elsif Nkind (Decl) = N_Private_Type_Declaration elsif Nkind_In (Decl, N_Private_Type_Declaration,
or else Nkind (Decl) = N_Incomplete_Type_Declaration N_Incomplete_Type_Declaration)
then then
Comp_Typ := Defining_Identifier (Decl); Comp_Typ := Defining_Identifier (Decl);
...@@ -4958,7 +4959,8 @@ package body Sem_Ch10 is ...@@ -4958,7 +4959,8 @@ package body Sem_Ch10 is
-- Build the header of the limited_view -- Build the header of the limited_view
Lim_Header := Make_Defining_Identifier (Sloc (N), Lim_Header :=
Make_Defining_Identifier (Sloc (N),
Chars => New_Internal_Name (Id_Char => 'Z')); Chars => New_Internal_Name (Id_Char => 'Z'));
Set_Ekind (Lim_Header, E_Package); Set_Ekind (Lim_Header, E_Package);
Set_Is_Internal (Lim_Header); Set_Is_Internal (Lim_Header);
...@@ -5410,7 +5412,6 @@ package body Sem_Ch10 is ...@@ -5410,7 +5412,6 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause if Nkind (Item) = N_With_Clause
and then Private_Present (Item) and then Private_Present (Item)
then then
-- If private_with_clause is redundant, remove it from -- If private_with_clause is redundant, remove it from
-- context, as a small optimization to subsequent handling -- context, as a small optimization to subsequent handling
-- of private_with clauses in other nested packages.. -- of private_with clauses in other nested packages..
...@@ -5418,7 +5419,6 @@ package body Sem_Ch10 is ...@@ -5418,7 +5419,6 @@ package body Sem_Ch10 is
if In_Regular_With_Clause (Entity (Name (Item))) then if In_Regular_With_Clause (Entity (Name (Item))) then
declare declare
Nxt : constant Node_Id := Next (Item); Nxt : constant Node_Id := Next (Item);
begin begin
Remove (Item); Remove (Item);
Item := Nxt; Item := Nxt;
...@@ -5451,7 +5451,6 @@ package body Sem_Ch10 is ...@@ -5451,7 +5451,6 @@ package body Sem_Ch10 is
P : constant Entity_Id := Scope (Unit_Name); P : constant Entity_Id := Scope (Unit_Name);
begin begin
if Debug_Flag_I then if Debug_Flag_I then
Write_Str ("remove unit "); Write_Str ("remove unit ");
Write_Name (Chars (Unit_Name)); Write_Name (Chars (Unit_Name));
......
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