Skip to content

R
riscv-gcc-1
Commit 9b91e150 by Ed Schonberg Committed by Arnaud Charlet
Options

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
Showing with 36 additions and 37 deletions
gcc/ada/sem_ch10.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -387,9 +387,9 @@ package body Sem_Ch10 is
elsif Nkind (Cont_Item) = N_Pragma
and then
(Chars (Cont_Item) = Name_Elaborate
(Pragma_Name (Cont_Item) = Name_Elaborate
or else
Chars (Cont_Item) = Name_Elaborate_All)
Pragma_Name (Cont_Item) = Name_Elaborate_All)
and then not Used_Type_Or_Elab
then
Prag_Unit :=
......@@ -759,7 +759,7 @@ package body Sem_Ch10 is
Set_Acts_As_Spec (N, False);
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);
end;
end if;
......@@ -910,7 +910,6 @@ package body Sem_Ch10 is
Add_Stub_Constructs (N);
end if;
end if;
-- Remove unit from visibility, so that environment is clean for
......@@ -1005,8 +1004,13 @@ package body Sem_Ch10 is
then
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)
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
and then Unit_Requires_Body (Nam))
then
......@@ -1237,7 +1241,7 @@ package body Sem_Ch10 is
Item := First (Context_Items (N));
while Present (Item)
and then Nkind (Item) = N_Pragma
and then Chars (Item) in Configuration_Pragma_Names
and then Pragma_Name (Item) in Configuration_Pragma_Names
loop
Analyze (Item);
Next (Item);
......@@ -1732,7 +1736,6 @@ package body Sem_Ch10 is
else
Optional_Subunit;
end if;
end Analyze_Proper_Body;
----------------------------------
......@@ -2693,20 +2696,21 @@ package body Sem_Ch10 is
begin
New_Nodes_OK := New_Nodes_OK + 1;
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));
Set_Library_Unit (Withn, P);
Set_Corresponding_Spec (Withn, Ent);
Set_First_Name (Withn, True);
Set_Implicit_With (Withn, True);
Set_Library_Unit (Withn, P);
Set_Corresponding_Spec (Withn, Ent);
Set_First_Name (Withn, True);
Set_Implicit_With (Withn, True);
-- If the unit is a package declaration, a private_with_clause on a
-- child unit implies that the implicit with on the parent is also
-- private.
if Nkind (Unit (N)) = N_Package_Declaration then
Set_Private_Present (Withn, Private_Present (Item));
Set_Private_Present (Withn, Private_Present (Item));
end if;
Prepend (Withn, Context_Items (N));
......@@ -2729,13 +2733,10 @@ package body Sem_Ch10 is
if Nkind (Unit) = N_Package_Body
and then Nkind (Original_Node (Unit)) = N_Package_Instantiation
then
return
Defining_Entity
(Specification (Instance_Spec (Original_Node (Unit))));
return Defining_Entity
(Specification (Instance_Spec (Original_Node (Unit))));
elsif Nkind (Unit) = N_Package_Instantiation then
return Defining_Entity (Specification (Instance_Spec (Unit)));
else
return Defining_Entity (Unit);
end if;
......@@ -2890,7 +2891,6 @@ package body Sem_Ch10 is
end if;
Install_Limited_Context_Clauses (N);
end Install_Context;
-----------------------------
......@@ -2913,7 +2913,7 @@ package body Sem_Ch10 is
Item := First (Context_Items (N));
while Present (Item)
and then Nkind (Item) = N_Pragma
and then Chars (Item) in Configuration_Pragma_Names
and then Pragma_Name (Item) in Configuration_Pragma_Names
loop
Next (Item);
end loop;
......@@ -3713,6 +3713,7 @@ package body Sem_Ch10 is
Item : Node_Id;
Id : Entity_Id;
Prev : Entity_Id;
begin
-- 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
......@@ -3950,8 +3951,8 @@ package body Sem_Ch10 is
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then not Limited_Present (Item)
and then Nkind (Unit (Library_Unit (Item)))
= N_Package_Declaration
and then Nkind (Unit (Library_Unit (Item))) =
N_Package_Declaration
then
Decl :=
First (Visible_Declarations
......@@ -4599,13 +4600,13 @@ package body Sem_Ch10 is
Unum : constant Unit_Number_Type := Get_Source_Unit (Library_Unit (N));
P : constant Entity_Id := Cunit_Entity (Unum);
Spec : Node_Id; -- To denote a package specification
Lim_Typ : Entity_Id; -- To denote shadow entities
Comp_Typ : Entity_Id; -- To denote real entities
Spec : Node_Id; -- To denote a package specification
Lim_Typ : Entity_Id; -- To denote shadow entities
Comp_Typ : Entity_Id; -- To denote real entities
Lim_Header : Entity_Id; -- Package entity
Last_Lim_E : Entity_Id := Empty; -- Last limited entity built
Last_Pub_Lim_E : Entity_Id; -- To set the first private entity
Lim_Header : Entity_Id; -- Package entity
Last_Lim_E : Entity_Id := Empty; -- Last limited entity built
Last_Pub_Lim_E : Entity_Id; -- To set the first private entity
procedure Decorate_Incomplete_Type
(E : Entity_Id;
......@@ -4805,8 +4806,8 @@ package body Sem_Ch10 is
Set_Non_Limited_View (Lim_Typ, Comp_Typ);
elsif Nkind (Decl) = N_Private_Type_Declaration
or else Nkind (Decl) = N_Incomplete_Type_Declaration
elsif Nkind_In (Decl, N_Private_Type_Declaration,
N_Incomplete_Type_Declaration)
then
Comp_Typ := Defining_Identifier (Decl);
......@@ -4879,7 +4880,7 @@ package body Sem_Ch10 is
Decorate_Package_Specification (Lim_Typ);
Set_Scope (Lim_Typ, Scope);
Set_Chars (Lim_Typ, Chars (Comp_Typ));
Set_Chars (Lim_Typ, Chars (Comp_Typ));
Set_Parent (Lim_Typ, Parent (Comp_Typ));
Set_From_With_Type (Lim_Typ);
......@@ -4958,8 +4959,9 @@ package body Sem_Ch10 is
-- Build the header of the limited_view
Lim_Header := Make_Defining_Identifier (Sloc (N),
Chars => New_Internal_Name (Id_Char => 'Z'));
Lim_Header :=
Make_Defining_Identifier (Sloc (N),
Chars => New_Internal_Name (Id_Char => 'Z'));
Set_Ekind (Lim_Header, E_Package);
Set_Is_Internal (Lim_Header);
Set_Limited_View (P, Lim_Header);
......@@ -5410,7 +5412,6 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause
and then Private_Present (Item)
then
-- If private_with_clause is redundant, remove it from
-- context, as a small optimization to subsequent handling
-- of private_with clauses in other nested packages..
......@@ -5418,7 +5419,6 @@ package body Sem_Ch10 is
if In_Regular_With_Clause (Entity (Name (Item))) then
declare
Nxt : constant Node_Id := Next (Item);
begin
Remove (Item);
Item := Nxt;
......@@ -5451,7 +5451,6 @@ package body Sem_Ch10 is
P : constant Entity_Id := Scope (Unit_Name);
begin
if Debug_Flag_I then
Write_Str ("remove unit ");
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