mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-02-05 06:59:33 +08:00
exp_pakd.adb: Minor comment fixes.
2009-04-22 Bob Duff <duff@adacore.com> * exp_pakd.adb: Minor comment fixes. * sinfo.ads, par-load.adb, sem_ch10.adb, lib-load.ads, lib-load.adb sem_ch12.adb: Change the meaning of the Library_Unit attribute to include units containing instantiations, as well as units that are generic instantiations. * sem.adb: Include dependents and corresponding specs/bodies in the unit walk. * gcc-interface/Make-lang.in: sem now depends on s-bitops, because of the packed array of Booleans. From-SVN: r146556
This commit is contained in:
Bob Duff
Arnaud Charlet
parent
c73b647896
commit
218e53ff25
@ -1,3 +1,18 @@
|
||||
2009-04-22 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_pakd.adb: Minor comment fixes.
|
||||
|
||||
* sinfo.ads, par-load.adb, sem_ch10.adb, lib-load.ads, lib-load.adb
|
||||
sem_ch12.adb: Change the meaning of the Library_Unit attribute to
|
||||
include units containing instantiations, as well as units that are
|
||||
generic instantiations.
|
||||
|
||||
* sem.adb: Include dependents and corresponding specs/bodies in the
|
||||
unit walk.
|
||||
|
||||
* gcc-interface/Make-lang.in:
|
||||
sem now depends on s-bitops, because of the packed array of Booleans.
|
||||
|
||||
2009-04-22 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/ada-tree.def: Fix formatting nits.
|
||||
|
||||
@ -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- --
|
||||
@ -1824,7 +1824,7 @@ package body Exp_Pakd is
|
||||
|
||||
-- Result : Ltype;
|
||||
|
||||
-- System.Bitops.Bit_And/Or/Xor
|
||||
-- System.Bit_Ops.Bit_And/Or/Xor
|
||||
-- (Left'Address,
|
||||
-- Ltype'Length * Ltype'Component_Size;
|
||||
-- Right'Address,
|
||||
@ -2183,7 +2183,7 @@ package body Exp_Pakd is
|
||||
|
||||
-- Result : Typ;
|
||||
|
||||
-- System.Bitops.Bit_Not
|
||||
-- System.Bit_Ops.Bit_Not
|
||||
-- (Opnd'Address,
|
||||
-- Typ'Length * Typ'Component_Size;
|
||||
-- Result'Address);
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
# Top level -*- makefile -*- fragment for GNU Ada (GNAT).
|
||||
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||
# 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
||||
|
||||
#This file is part of GCC.
|
||||
|
||||
@ -118,7 +118,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
|
||||
|
||||
# Object files from Ada sources that are used by gnat1
|
||||
|
||||
GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
|
||||
GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
|
||||
ada/a-elchha.o ada/a-ioexce.o \
|
||||
ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
|
||||
ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/ali.o \
|
||||
@ -2406,15 +2406,15 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/sem_type.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
|
||||
ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \
|
||||
ada/sprint.ads ada/stand.ads ada/stringt.ads ada/system.ads \
|
||||
ada/s-assert.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
|
||||
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
|
||||
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
|
||||
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
|
||||
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
|
||||
ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \
|
||||
ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
|
||||
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \
|
||||
ada/widechar.ads
|
||||
ada/s-assert.ads ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads \
|
||||
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
|
||||
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
|
||||
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
|
||||
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
|
||||
ada/table.adb ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads \
|
||||
ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
|
||||
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
|
||||
ada/usage.ads ada/widechar.ads
|
||||
|
||||
ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \
|
||||
ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \
|
||||
@ -2871,6 +2871,10 @@ ada/s-assert.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
|
||||
ada/s-stoele.adb ada/s-traent.ads
|
||||
|
||||
ada/s-bitops.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/system.ads ada/s-bitops.ads ada/s-bitops.adb ada/s-parame.ads \
|
||||
ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads
|
||||
|
||||
ada/s-carun8.o : ada/ada.ads ada/a-unccon.ads ada/system.ads \
|
||||
ada/s-addope.ads ada/s-addope.adb ada/s-carun8.ads ada/s-carun8.adb
|
||||
|
||||
|
||||
@ -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- --
|
||||
@ -766,17 +766,27 @@ package body Lib.Load is
|
||||
-- declaration has been attached to a new compilation unit node, and
|
||||
-- code will have to be generated for it.
|
||||
|
||||
procedure Make_Instance_Unit (N : Node_Id) is
|
||||
procedure Make_Instance_Unit (N : Node_Id; In_Main : Boolean) is
|
||||
Sind : constant Source_File_Index := Source_Index (Main_Unit);
|
||||
begin
|
||||
Units.Increment_Last;
|
||||
Units.Table (Units.Last) := Units.Table (Main_Unit);
|
||||
Units.Table (Units.Last).Cunit := Library_Unit (N);
|
||||
Units.Table (Units.Last).Generate_Code := True;
|
||||
Units.Table (Main_Unit).Cunit := N;
|
||||
Units.Table (Main_Unit).Unit_Name :=
|
||||
Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
|
||||
Units.Table (Main_Unit).Version := Source_Checksum (Sind);
|
||||
|
||||
if In_Main then
|
||||
Units.Table (Units.Last) := Units.Table (Main_Unit);
|
||||
Units.Table (Units.Last).Cunit := Library_Unit (N);
|
||||
Units.Table (Units.Last).Generate_Code := True;
|
||||
Units.Table (Main_Unit).Cunit := N;
|
||||
Units.Table (Main_Unit).Unit_Name :=
|
||||
Get_Body_Name
|
||||
(Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
|
||||
Units.Table (Main_Unit).Version := Source_Checksum (Sind);
|
||||
|
||||
else
|
||||
-- Duplicate information from instance unit, for the body.
|
||||
Units.Table (Units.Last) :=
|
||||
Units.Table (Get_Cunit_Unit_Number (Library_Unit (N)));
|
||||
Units.Table (Units.Last).Cunit := N;
|
||||
end if;
|
||||
end Make_Instance_Unit;
|
||||
|
||||
------------------------
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -169,13 +169,20 @@ 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_Instance_Unit (N : Node_Id);
|
||||
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
|
||||
-- own elaboration routine. The file itself corresponds to the declaration.
|
||||
-- We create an additional entry for the body, so that the binder can
|
||||
-- generate the proper elaboration calls to both. The argument N is the
|
||||
-- compilation unit node created for the body.
|
||||
-- If the instance is not the main program, we still generate the instance
|
||||
-- body even though we do not generate code for it. In that case we still
|
||||
-- generate a compilation unit node for it, and we need to make an entry
|
||||
-- for it in the units table, so as to maintain a one-to-one mapping
|
||||
-- between table and nodes. The table entry is used among other things to
|
||||
-- provide a canonical traversal order for context units for Inspector.
|
||||
-- The flag In_Main indicates whether the instance is the main unit.
|
||||
|
||||
procedure Version_Update (U : Node_Id; From : Node_Id);
|
||||
-- This routine is called when unit U is found to be semantically
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2007, 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- --
|
||||
@ -266,12 +266,13 @@ begin
|
||||
Error_Node => Curunit,
|
||||
Corr_Body => Cur_Unum);
|
||||
|
||||
-- If we successfully load the unit, then set the spec pointer. Once
|
||||
-- again note that if the loaded unit has a fatal error, Load will
|
||||
-- have set our Fatal_Error flag to propagate this condition.
|
||||
-- If we successfully load the unit, then set the spec/body
|
||||
-- pointers. Once again note that if the loaded unit has a fatal error,
|
||||
-- Load will have set our Fatal_Error flag to propagate this condition.
|
||||
|
||||
if Unum /= No_Unit then
|
||||
Set_Library_Unit (Curunit, Cunit (Unum));
|
||||
Set_Library_Unit (Cunit (Unum), Curunit);
|
||||
|
||||
-- If this is a separate spec for the main unit, then we reset
|
||||
-- Main_Unit_Entity to point to the entity for this separate spec
|
||||
|
||||
315
gcc/ada/sem.adb
315
gcc/ada/sem.adb
@ -77,15 +77,28 @@ package body Sem is
|
||||
-- No_Elist, because it's too early to call New_Elmt_List; we will set it
|
||||
-- to New_Elmt_List on first use.
|
||||
|
||||
Ignore_Comp_Units : Boolean := False;
|
||||
-- If True, we suppress appending compilation units onto the
|
||||
-- Comp_Unit_List.
|
||||
generic
|
||||
with procedure Action (Withed_Unit : Node_Id);
|
||||
procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean);
|
||||
-- Walk all the with clauses of CU, and call Action for the with'ed
|
||||
-- unit. Ignore limited withs, unless Include_Limited is True.
|
||||
-- CU must be an N_Compilation_Unit.
|
||||
|
||||
generic
|
||||
with procedure Action (Withed_Unit : Node_Id);
|
||||
procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean);
|
||||
-- Same as Walk_Withs_Immediate, but also include with clauses on subunits
|
||||
-- of this unit, since they count as dependences on their parent library
|
||||
-- item. CU must be an N_Compilation_Unit whose Unit is not an N_Subunit.
|
||||
|
||||
procedure Write_Unit_Info
|
||||
(Unit_Num : Unit_Number_Type;
|
||||
Item : Node_Id;
|
||||
Prefix : String := "");
|
||||
-- Print out debugging information about the unit
|
||||
Prefix : String := "";
|
||||
Withs : Boolean := False);
|
||||
-- Print out debugging information about the unit. Prefix precedes the rest
|
||||
-- of the printout. If Withs is True, we print out units with'ed by this
|
||||
-- unit (not counting limited withs).
|
||||
|
||||
-------------
|
||||
-- Analyze --
|
||||
@ -1429,18 +1442,13 @@ package body Sem is
|
||||
|
||||
Do_Analyze;
|
||||
|
||||
if Ignore_Comp_Units then
|
||||
null;
|
||||
|
||||
elsif Present (Comp_Unit)
|
||||
if Present (Comp_Unit)
|
||||
and then Nkind (Unit (Comp_Unit)) in N_Proper_Body
|
||||
and then not In_Extended_Main_Source_Unit (Comp_Unit)
|
||||
then
|
||||
null;
|
||||
|
||||
else
|
||||
pragma Assert (not Ignore_Comp_Units);
|
||||
|
||||
-- Initialize if first time
|
||||
|
||||
if No (Comp_Unit_List) then
|
||||
@ -1454,12 +1462,6 @@ package body Sem is
|
||||
Write_Unit_Info
|
||||
(Get_Cunit_Unit_Number (Comp_Unit), Unit (Comp_Unit));
|
||||
end if;
|
||||
|
||||
-- Ignore all units after main unit
|
||||
|
||||
if Comp_Unit = Cunit (Main_Unit) then
|
||||
Ignore_Comp_Units := True;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -1501,11 +1503,21 @@ package body Sem is
|
||||
|
||||
procedure Walk_Library_Items is
|
||||
type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
|
||||
Seen : Unit_Number_Set := (others => False);
|
||||
pragma Pack (Unit_Number_Set);
|
||||
Seen, Done : Unit_Number_Set := (others => False);
|
||||
-- Seen (X) is True after we have seen unit X in the walk. This is used
|
||||
-- to prevent processing the same unit more than once. Done (X) is True
|
||||
-- after we have fully processed X, and is used only for debugging
|
||||
-- printouts and assertions.
|
||||
|
||||
procedure Do_Action (CU : Node_Id; Item : Node_Id);
|
||||
-- Calls Action, with some validity checks
|
||||
|
||||
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id);
|
||||
-- Calls Do_Action, first on the units with'ed by this one, then on this
|
||||
-- unit. If it's an instance body, do the spec first. If it's an
|
||||
-- instance spec, do the body last.
|
||||
|
||||
---------------
|
||||
-- Do_Action --
|
||||
---------------
|
||||
@ -1557,23 +1569,66 @@ package body Sem is
|
||||
pragma Assert (Item = Unit (CU));
|
||||
|
||||
declare
|
||||
Unit_Num : constant Unit_Number_Type :=
|
||||
Get_Cunit_Unit_Number (CU);
|
||||
Unit_Num : constant Unit_Number_Type :=
|
||||
Get_Cunit_Unit_Number (CU);
|
||||
|
||||
procedure Assert_Done (Withed_Unit : Node_Id);
|
||||
-- Assert Withed_Unit is already Done
|
||||
|
||||
procedure Assert_Done (Withed_Unit : Node_Id) is
|
||||
begin
|
||||
if not Done
|
||||
(Get_Cunit_Unit_Number
|
||||
(Withed_Unit))
|
||||
then
|
||||
Write_Unit_Name
|
||||
(Unit_Name
|
||||
(Get_Cunit_Unit_Number
|
||||
(Withed_Unit)));
|
||||
Write_Str (" not yet walked!");
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
if False then
|
||||
-- This assertion is disabled because it fails in the
|
||||
-- presence of subunits.
|
||||
pragma Assert -- ???
|
||||
(Done
|
||||
(Get_Cunit_Unit_Number (Withed_Unit)));
|
||||
null;
|
||||
end if;
|
||||
end Assert_Done;
|
||||
|
||||
procedure Assert_Withed_Units_Done is
|
||||
new Walk_Withs (Assert_Done);
|
||||
begin
|
||||
if Debug_Unit_Walk then
|
||||
Write_Unit_Info (Unit_Num, Item);
|
||||
end if;
|
||||
|
||||
-- This assertion is commented out because it fails in some
|
||||
-- circumstances related to library-level generic
|
||||
-- instantiations. We need to investigate why.
|
||||
-- ???pragma Assert (not Seen (Unit_Num));
|
||||
-- Main unit should come last
|
||||
|
||||
Seen (Unit_Num) := True;
|
||||
if Done (Main_Unit) then
|
||||
Write_Line ("Main unit is done!");
|
||||
end if;
|
||||
if False then -- ???
|
||||
-- This assertion is disabled because it fails in the
|
||||
-- presence of subunits.
|
||||
pragma Assert (not Done (Main_Unit));
|
||||
null;
|
||||
end if;
|
||||
|
||||
-- We shouldn't do the same thing twice
|
||||
|
||||
pragma Assert (not Done (Unit_Num));
|
||||
|
||||
-- Everything we depend upon should already be done
|
||||
|
||||
Assert_Withed_Units_Done (CU, Include_Limited => False);
|
||||
end;
|
||||
|
||||
else
|
||||
-- Must be Standard
|
||||
-- Must be Standard, which has no entry in the units table
|
||||
|
||||
pragma Assert (Item = Stand.Standard_Package_Node);
|
||||
|
||||
@ -1585,6 +1640,68 @@ package body Sem is
|
||||
Action (Item);
|
||||
end Do_Action;
|
||||
|
||||
----------------------------
|
||||
-- Do_Unit_And_Dependents --
|
||||
----------------------------
|
||||
|
||||
procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
|
||||
Unit_Num : constant Unit_Number_Type :=
|
||||
Get_Cunit_Unit_Number (CU);
|
||||
|
||||
procedure Do_Withed_Unit (Withed_Unit : Node_Id);
|
||||
-- Pass the buck to Do_Unit_And_Dependents
|
||||
|
||||
procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
|
||||
begin
|
||||
Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
|
||||
end Do_Withed_Unit;
|
||||
|
||||
procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
|
||||
begin
|
||||
if Seen (Unit_Num) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Seen (Unit_Num) := True;
|
||||
|
||||
-- Process corresponding spec of body first
|
||||
|
||||
if Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
|
||||
declare
|
||||
Spec_Unit : constant Node_Id := Library_Unit (CU);
|
||||
begin
|
||||
Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Process the with clauses
|
||||
|
||||
Do_Withed_Units (CU, Include_Limited => False);
|
||||
|
||||
-- Process the unit itself
|
||||
|
||||
if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
|
||||
or else CU = Cunit (Main_Unit)
|
||||
then
|
||||
|
||||
Do_Action (CU, Item);
|
||||
|
||||
Done (Unit_Num) := True;
|
||||
end if;
|
||||
|
||||
-- Process the corresponding body last
|
||||
|
||||
if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
|
||||
declare
|
||||
Body_Unit : constant Node_Id := Library_Unit (CU);
|
||||
begin
|
||||
if Present (Body_Unit) then
|
||||
Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end Do_Unit_And_Dependents;
|
||||
|
||||
-- Local Declarations
|
||||
|
||||
Cur : Elmt_Id := First_Elmt (Comp_Unit_List);
|
||||
@ -1638,24 +1755,20 @@ package body Sem is
|
||||
declare
|
||||
Spec_Unit : constant Node_Id := Library_Unit (CU);
|
||||
begin
|
||||
Do_Action (Spec_Unit, Unit (Spec_Unit));
|
||||
Do_Unit_And_Dependents
|
||||
(Spec_Unit, Unit (Spec_Unit));
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
|
||||
if CU = Cunit (Main_Unit) then
|
||||
|
||||
-- Must come last
|
||||
|
||||
pragma Assert (No (Next_Elmt (Cur)));
|
||||
|
||||
Do_Action (CU, N);
|
||||
Do_Unit_And_Dependents (CU, N);
|
||||
end if;
|
||||
|
||||
-- It's a spec, so just do it
|
||||
|
||||
when others =>
|
||||
Do_Action (CU, N);
|
||||
Do_Unit_And_Dependents (CU, N);
|
||||
end case;
|
||||
end;
|
||||
|
||||
@ -1663,14 +1776,14 @@ package body Sem is
|
||||
end loop;
|
||||
|
||||
if Debug_Unit_Walk then
|
||||
if Seen /= (Seen'Range => True) then
|
||||
if Done /= (Done'Range => True) then
|
||||
Write_Eol;
|
||||
Write_Line ("Ignored units:");
|
||||
|
||||
Indent;
|
||||
|
||||
for Unit_Num in Seen'Range loop
|
||||
if not Seen (Unit_Num) then
|
||||
for Unit_Num in Done'Range loop
|
||||
if not Done (Unit_Num) then
|
||||
Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num)));
|
||||
end if;
|
||||
end loop;
|
||||
@ -1679,12 +1792,93 @@ package body Sem is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
pragma Assert (Done (Main_Unit));
|
||||
|
||||
if Debug_Unit_Walk then
|
||||
Outdent;
|
||||
Write_Line ("end Walk_Library_Items.");
|
||||
end if;
|
||||
end Walk_Library_Items;
|
||||
|
||||
----------------
|
||||
-- Walk_Withs --
|
||||
----------------
|
||||
|
||||
procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean) is
|
||||
pragma Assert (Nkind (CU) = N_Compilation_Unit);
|
||||
pragma Assert (Nkind (Unit (CU)) /= N_Subunit);
|
||||
|
||||
procedure Walk_Immediate is new Walk_Withs_Immediate (Action);
|
||||
begin
|
||||
-- First walk the withs immediately on the library item
|
||||
|
||||
Walk_Immediate (CU, Include_Limited);
|
||||
|
||||
-- For a body, we must also check for any subunits which belong to
|
||||
-- it and which have context clauses of their own, since these
|
||||
-- with'ed units are part of its own dependencies.
|
||||
|
||||
if Nkind (Unit (CU)) in N_Unit_Body then
|
||||
for S in Main_Unit .. Last_Unit loop
|
||||
|
||||
-- We are only interested in subunits. For preproc. data and
|
||||
-- def. files, Cunit is Empty, so we need to test that first.
|
||||
|
||||
if Cunit (S) /= Empty
|
||||
and then Nkind (Unit (Cunit (S))) = N_Subunit
|
||||
then
|
||||
declare
|
||||
Pnode : Node_Id;
|
||||
begin
|
||||
Pnode := Library_Unit (Cunit (S));
|
||||
|
||||
-- In -gnatc mode, the errors in the subunits will not
|
||||
-- have been recorded, but the analysis of the subunit
|
||||
-- may have failed, so just quit.
|
||||
|
||||
if No (Pnode) then
|
||||
exit;
|
||||
end if;
|
||||
|
||||
-- Find ultimate parent of the subunit
|
||||
|
||||
while Nkind (Unit (Pnode)) = N_Subunit loop
|
||||
Pnode := Library_Unit (Pnode);
|
||||
end loop;
|
||||
|
||||
-- See if it belongs to current unit, and if so, include its
|
||||
-- with_clauses.
|
||||
|
||||
if Pnode = CU then
|
||||
Walk_Immediate (Cunit (S), Include_Limited);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end loop;
|
||||
end if;
|
||||
end Walk_Withs;
|
||||
|
||||
--------------------------
|
||||
-- Walk_Withs_Immediate --
|
||||
--------------------------
|
||||
|
||||
procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean) is
|
||||
pragma Assert (Nkind (CU) = N_Compilation_Unit);
|
||||
|
||||
Context_Item : Node_Id := First (Context_Items (CU));
|
||||
begin
|
||||
while Present (Context_Item) loop
|
||||
if Nkind (Context_Item) = N_With_Clause
|
||||
and then (Include_Limited
|
||||
or else not Limited_Present (Context_Item))
|
||||
then
|
||||
Action (Library_Unit (Context_Item));
|
||||
end if;
|
||||
|
||||
Context_Item := Next (Context_Item);
|
||||
end loop;
|
||||
end Walk_Withs_Immediate;
|
||||
|
||||
---------------------
|
||||
-- Write_Unit_Info --
|
||||
---------------------
|
||||
@ -1692,7 +1886,8 @@ package body Sem is
|
||||
procedure Write_Unit_Info
|
||||
(Unit_Num : Unit_Number_Type;
|
||||
Item : Node_Id;
|
||||
Prefix : String := "")
|
||||
Prefix : String := "";
|
||||
Withs : Boolean := False)
|
||||
is
|
||||
begin
|
||||
Write_Str (Prefix);
|
||||
@ -1712,6 +1907,50 @@ package body Sem is
|
||||
end if;
|
||||
|
||||
Write_Eol;
|
||||
|
||||
-- Skip the rest if we're not supposed to print the withs
|
||||
|
||||
if False and then not Withs then -- ???
|
||||
return;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Context_Item : Node_Id := First (Context_Items (Cunit (Unit_Num)));
|
||||
begin
|
||||
while Present (Context_Item)
|
||||
and then (Nkind (Context_Item) /= N_With_Clause
|
||||
or else Limited_Present (Context_Item))
|
||||
loop
|
||||
Context_Item := Next (Context_Item);
|
||||
end loop;
|
||||
|
||||
if Present (Context_Item) then
|
||||
Indent;
|
||||
Write_Line ("withs:");
|
||||
Indent;
|
||||
|
||||
while Present (Context_Item) loop
|
||||
if Nkind (Context_Item) = N_With_Clause
|
||||
and then not Limited_Present (Context_Item)
|
||||
then
|
||||
pragma Assert (Present (Library_Unit (Context_Item)));
|
||||
Write_Unit_Name
|
||||
(Unit_Name
|
||||
(Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
|
||||
if Implicit_With (Context_Item) then
|
||||
Write_Str (" -- implicit");
|
||||
end if;
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
Context_Item := Next (Context_Item);
|
||||
end loop;
|
||||
|
||||
Outdent;
|
||||
Write_Line ("end withs");
|
||||
Outdent;
|
||||
end if;
|
||||
end;
|
||||
end Write_Unit_Info;
|
||||
|
||||
end Sem;
|
||||
|
||||
@ -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- --
|
||||
@ -3283,7 +3283,7 @@ package body Sem_Ch10 is
|
||||
and then Renamed_Entity (E) = WEnt
|
||||
then
|
||||
-- The unlimited view is visible through use clause and
|
||||
-- renamings. There is not need to generate the error
|
||||
-- renamings. There is no need to generate the error
|
||||
-- message here because Is_Visible_Through_Renamings
|
||||
-- takes care of generating the precise error message.
|
||||
|
||||
@ -4322,7 +4322,7 @@ package body Sem_Ch10 is
|
||||
then
|
||||
-- Generate the error message only if the current unit
|
||||
-- is a package declaration; in case of subprogram
|
||||
-- bodies and package bodies we just return true to
|
||||
-- bodies and package bodies we just return True to
|
||||
-- indicate that the limited view must not be
|
||||
-- installed.
|
||||
|
||||
@ -4348,7 +4348,13 @@ package body Sem_Ch10 is
|
||||
Next (Item);
|
||||
end loop;
|
||||
|
||||
if Present (Library_Unit (Aux_Unit)) then
|
||||
-- If it's a body not acting as spec, follow pointer to
|
||||
-- corresponding spec, otherwise follow pointer to parent spec.
|
||||
|
||||
if Present (Library_Unit (Aux_Unit))
|
||||
and then Nkind_In (Unit (Aux_Unit),
|
||||
N_Package_Body, N_Subprogram_Body)
|
||||
then
|
||||
if Aux_Unit = Library_Unit (Aux_Unit) then
|
||||
|
||||
-- Aux_Unit is a body that acts as a spec. Clause has
|
||||
@ -4359,6 +4365,7 @@ package body Sem_Ch10 is
|
||||
else
|
||||
Aux_Unit := Library_Unit (Aux_Unit);
|
||||
end if;
|
||||
|
||||
else
|
||||
Aux_Unit := Parent_Spec (Unit (Aux_Unit));
|
||||
end if;
|
||||
|
||||
@ -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- --
|
||||
@ -4393,6 +4393,7 @@ package body Sem_Ch12 is
|
||||
-- and elaboration entity are not relevant to the compilation.
|
||||
|
||||
if Parent (N) /= Cunit (Main_Unit) then
|
||||
Make_Instance_Unit (Body_Cunit, In_Main => False);
|
||||
return;
|
||||
end if;
|
||||
|
||||
@ -4423,7 +4424,7 @@ package body Sem_Ch12 is
|
||||
-- Make entry in Units table, so that binder can generate call to
|
||||
-- elaboration procedure for body, if any.
|
||||
|
||||
Make_Instance_Unit (Body_Cunit);
|
||||
Make_Instance_Unit (Body_Cunit, In_Main => True);
|
||||
Main_Unit_Entity := New_Main;
|
||||
Set_Cunit_Entity (Main_Unit, Main_Unit_Entity);
|
||||
|
||||
|
||||
@ -1287,19 +1287,16 @@ package Sinfo is
|
||||
--
|
||||
-- In a compilation unit node, the usage depends on the unit type:
|
||||
--
|
||||
-- For a subprogram body, Library_Unit points to the compilation unit
|
||||
-- node of the corresponding spec, unless Acts_As_Spec is set, in which
|
||||
-- case it points to itself.
|
||||
-- For a library unit body, Library_Unit points to the compilation unit
|
||||
-- node of the corresponding spec, unless it's a subprogram body with
|
||||
-- Acts_As_Spec set, in which case it points to itself.
|
||||
--
|
||||
-- For a package body, Library_Unit points to the compilation unit of
|
||||
-- the corresponding package spec.
|
||||
--
|
||||
-- For a subprogram spec to which pragma Inline applies, Library_Unit
|
||||
-- points to the compilation unit node of the corresponding body, if
|
||||
-- inlining is active.
|
||||
--
|
||||
-- For a generic declaration, Library_Unit points to the compilation
|
||||
-- unit node of the corresponding generic body.
|
||||
-- For a spec, Library_Unit points to the compilation unit node of the
|
||||
-- corresponding body, if present. The body will be present if the spec
|
||||
-- is or contains generics that we needed to instantiate. Similarly, the
|
||||
-- body will be present if we needed it for inlining purposes. Thus, if
|
||||
-- we have a spec/body pair, both of which are present, they point to
|
||||
-- each other via Library_Unit.
|
||||
--
|
||||
-- For a subunit, Library_Unit points to the compilation unit node of
|
||||
-- the parent body.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user