mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-01-27 16:54:31 +08:00
Code Issues Packages Projects Releases Wiki Activity

lib-load.ads, [...] (Make_Child_Decl_Unit): New subprogram...

Browse Source 
2009-04-22  Ed Schonberg  <schonberg@adacore.com>

	* lib-load.ads, lib-load.adb (Make_Child_Decl_Unit): New subprogram, to
	create a unit table entry for the subprogram declaration created for a
	child suprogram body that has no separate specification.

	* sem_ch10.adb (Analyze_Compilation_Unit): For a child unit that is a
	subprogram body, call Make_Child_Decl_Unit.

	* lib.adb (Get_Cunit_Unit_Number): Verify that an entry not yet in the
	table can only be the created specification of a child subprogram body
	that is the main unit, which has not been entered in the table yet.

	* errout.adb  (Output_Messages): Ignore created specification of a
	child subprogram body to prevent repeated listing of error messages.

	* gnat1drv.adb (gnat1drv): The generated specification for a child
	subprogram body does not generate code.

From-SVN: r146559
This commit is contained in:
Ed Schonberg 2009-04-22 10:11:00 +00:00 committed by Arnaud Charlet
parent 1ef4d0a80a
commit f3a67cfc20
7 changed files with 86 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2009-04-22 Ed Schonberg <schonberg@adacore.com>
* lib-load.ads, lib-load.adb (Make_Child_Decl_Unit): New subprogram, to
create a unit table entry for the subprogram declaration created for a
child suprogram body that has no separate specification.
* sem_ch10.adb (Analyze_Compilation_Unit): For a child unit that is a
subprogram body, call Make_Child_Decl_Unit.
* lib.adb (Get_Cunit_Unit_Number): Verify that an entry not yet in the
table can only be the created specification of a child subprogram body
that is the main unit, which has not been entered in the table yet.
* errout.adb (Output_Messages): Ignore created specification of a
child subprogram body to prevent repeated listing of error messages.
* gnat1drv.adb (gnat1drv): The generated specification for a child
subprogram body does not generate code.
2009-04-22 Arnaud Charlet <charlet@adacore.com>
* s-bitops.adb, s-bitops.ads (Raise_Error): Do not use Ada 05 syntax,

16
gcc/ada/errout.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
@ -1681,11 +1681,21 @@ package body Errout is
-- First list extended main source file units with errors
-- Note: if debug flag d.m is set, only the main source is listed
for U in Main_Unit .. Last_Unit loop
if In_Extended_Main_Source_Unit (Cunit_Entity (U))
-- If debug flag d.m is set, only the main source is listed
and then (U = Main_Unit or else not Debug_Flag_Dot_M)
-- If the unit of the entity does not come from source, it is
-- an implicit subprogram declaration for a child subprogram.
-- Do not emit errors for it, they are listed with the body.
and then
(No (Cunit_Entity (U))
or else Comes_From_Source (Cunit_Entity (U))
or else not Is_Subprogram (Cunit_Entity (U)))
then
declare
Sfile : constant Source_File_Index := Source_Index (U);

17
gcc/ada/gnat1drv.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
@ -510,14 +510,21 @@ begin
Set_Generate_Code (Main_Unit);
-- If we have a corresponding spec, then we need object
-- code for the spec unit as well
-- If we have a corresponding spec, and it comes from source
-- or it is not a generated spec for a child subprogram body,
-- then we need object code for the spec unit as well
if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
and then not Acts_As_Spec (Main_Unit_Node)
then
Set_Generate_Code
(Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node)));
if Nkind (Main_Unit_Node) = N_Subprogram_Body
and then not Comes_From_Source (Library_Unit (Main_Unit_Node))
then
null;
else
Set_Generate_Code
(Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node)));
end if;
end if;
-- Case of no code required to be generated, exit indicating no error

24
gcc/ada/lib-load.adb
View File

@ -753,6 +753,30 @@ package body Lib.Load is
end if;
end Load_Unit;
--------------------------
-- Make_Child_Decl_Unit --
--------------------------
procedure Make_Child_Decl_Unit (N : Node_Id) is
Unit_Decl : constant Node_Id := Library_Unit (N);
begin
Units.Increment_Last;
Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N));
Units.Table (Units.Last).Unit_Name :=
Get_Spec_Name (Unit_Name (Get_Cunit_Unit_Number (N)));
Units.Table (Units.Last).Cunit := Unit_Decl;
Units.Table (Units.Last).Cunit_Entity :=
Defining_Identifier
(Defining_Unit_Name (Specification (Unit (Unit_Decl))));
-- The library unit created for of a child subprogram unit plays no
-- role in code generation and binding, so label it accordingly.
Units.Table (Units.Last).Generate_Code := False;
Set_Has_No_Elaboration_Code (Unit_Decl);
end Make_Child_Decl_Unit;
------------------------
-- Make_Instance_Unit --
------------------------

6
gcc/ada/lib-load.ads
View File

@ -169,6 +169,12 @@ package Lib.Load is
-- creates a dummy package unit so that compilation can continue without
-- blowing up when the missing unit is referenced.
procedure Make_Child_Decl_Unit (N : Node_Id);
-- For a child subprogram body without a spec, we create a subprogram
-- declaration in order to attach the required parent link. We create
-- a Units_Table entry for this declaration, in order to maintain a
-- one-to-one correspondence between compilation units and table entries.
procedure Make_Instance_Unit (N : Node_Id; In_Main : Boolean);
-- When a compilation unit is an instantiation, it contains both the
-- declaration and the body of the instance, each of which can have its

10
gcc/ada/lib.adb
View File

@ -602,10 +602,14 @@ package body Lib is
end if;
end loop;
-- If not in the table, must be the main source unit, and we just
-- have not got it put into the table yet.
-- If not in the table, must be a spec created for a main unit that is a
-- child subprogram body which we have not inserted into the table yet.
return Main_Unit;
if N /= Library_Unit (Cunit (Main_Unit)) then
raise Program_Error;
else
return Main_Unit;
end if;
end Get_Cunit_Unit_Number;
---------------------

6
gcc/ada/sem_ch10.adb
View File

@ -731,7 +731,10 @@ package body Sem_Ch10 is
-- it, and this must be indicated explicitly. We also mark
-- the body entity as a child unit now, to prevent a
-- cascaded error if the spec entity cannot be entered
-- in its scope.
-- in its scope. Finally we create a Units table entry for
-- the subprogram declaration, to maintain a one-to-one
-- correspondence with compilation unit nodes. This is
-- critical for the tree traversals performed by Inspector.
declare
Loc : constant Source_Ptr := Sloc (N);
@ -753,6 +756,7 @@ package body Sem_Ch10 is
Set_Library_Unit (N, Lib_Unit);
Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum));
Make_Child_Decl_Unit (N);
Semantics (Lib_Unit);
-- Now that a separate declaration exists, the body