mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-25 01:20:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-08-10  Robert Dewar  <dewar@adacore.com>

	* a-suenco.adb (Convert): Fix bug in UTF-16 to UTF-8 conversion for
	codes in the range 16#80#..16#7FF#.
	* sem_ch10.adb: Minor reformatting.

2010-08-10  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb (Scan_Front_End_Switches): Always perform semantics and
	generate ali files in CodePeer mode, so that a gnatmake -c -k will
	proceed further when possible
	* freeze.adb (Freeze_Static_Object): Fix thinko. Do not generate error
	messages when ignoring representation clauses (-gnatI).

2010-08-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): Do not attempt to
	constant-fold discriminant reference if the constraint is an object
	with non-static expression. Expression may contain volatile references
	in the presence of renamings.

2010-08-10  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb (Get_Attribute_Index): If Index is All_Other_Names,
	returns Index.
	* prj-strt.adb (Attribute_Reference): Recognize 'others' as a valid
	index for an associative array where it is allowed.

From-SVN: r163060
This commit is contained in:
Arnaud Charlet 2010-08-10 15:43:01 +02:00
parent 1f92d7f29a
commit d606f1df14
8 changed files with 203 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2010-08-10 Robert Dewar <dewar@adacore.com>
* a-suenco.adb (Convert): Fix bug in UTF-16 to UTF-8 conversion for
codes in the range 16#80#..16#7FF#.
* sem_ch10.adb: Minor reformatting.
2010-08-10 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Scan_Front_End_Switches): Always perform semantics and
generate ali files in CodePeer mode, so that a gnatmake -c -k will
proceed further when possible
* freeze.adb (Freeze_Static_Object): Fix thinko. Do not generate error
messages when ignoring representation clauses (-gnatI).
2010-08-10 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Selected_Component): Do not attempt to
constant-fold discriminant reference if the constraint is an object
with non-static expression. Expression may contain volatile references
in the presence of renamings.
2010-08-10 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Get_Attribute_Index): If Index is All_Other_Names,
returns Index.
* prj-strt.adb (Attribute_Reference): Recognize 'others' as a valid
index for an associative array where it is allowed.
2010-08-10 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb: Add comments.

8
gcc/ada/a-suenco.adb
View File

@ -34,7 +34,7 @@
package body Ada.Strings.UTF_Encoding.Conversions is
use Interfaces;
-- Version convertion from UTF-8/UTF-16BE/LE to UTF-8/UTF-16BE/LE
-- Convert from UTF-8/UTF-16BE/LE to UTF-8/UTF-16BE/LE
function Convert
(Item : UTF_String;
@ -57,7 +57,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
end if;
end Convert;
-- Version converting UTF-8/UTF-16BE/LE to UTF-16
-- Convert from UTF-8/UTF-16BE/LE to UTF-16
function Convert
(Item : UTF_String;
@ -72,7 +72,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
end if;
end Convert;
-- Version converting UTF-8 to UTF-16
-- Convert from UTF-8 to UTF-16
function Convert
(Item : UTF_8_String;
@ -316,7 +316,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
elsif C1 <= 16#07FF# then
Result (Len + 1) :=
Character'Val
(2#110_000000# or Shift_Right (C1, 6));
(2#110_00000# or Shift_Right (C1, 6));
Result (Len + 2) :=
Character'Val
(2#10_000000# or (C1 and 2#00_111111#));

48
gcc/ada/exp_ch4.adb
View File

@ -7358,6 +7358,7 @@ package body Exp_Ch4 is
Disc : Entity_Id;
New_N : Node_Id;
Dcon : Elmt_Id;
Dval : Node_Id;
function In_Left_Hand_Side (Comp : Node_Id) return Boolean;
-- Gigi needs a temporary for prefixes that depend on a discriminant,
@ -7472,18 +7473,6 @@ package body Exp_Ch4 is
then
null;
-- If this is a discriminant of a component of a mutable record,
-- or a renaming of such, no optimization is possible, and value
-- must be retrieved anew. Note that in the previous case we may
-- be dealing with a renaming declaration, while here we may have
-- a use of a renaming.
elsif Nkind (P) = N_Selected_Component
and then Is_Record_Type (Etype (Prefix (P)))
and then not Is_Constrained (Etype (Prefix (P)))
then
null;
-- Don't do this optimization if we are within the code for a
-- discriminant check, since the whole point of such a check may
-- be to verify the condition on which the code below depends!
@ -7501,7 +7490,9 @@ package body Exp_Ch4 is
Disc := First_Discriminant (Ptyp);
Dcon := First_Elmt (Discriminant_Constraint (Ptyp));
Discr_Loop : while Present (Dcon) loop
Dval := Node (Dcon);
-- Check if this is the matching discriminant
@ -7512,9 +7503,30 @@ package body Exp_Ch4 is
-- constrained by an outer discriminant, which cannot
-- be optimized away.
if
Denotes_Discriminant
(Node (Dcon), Check_Concurrent => True)
if Denotes_Discriminant
(Dval, Check_Concurrent => True)
then
exit Discr_Loop;
elsif Nkind (Original_Node (Dval)) = N_Selected_Component
and then
Denotes_Discriminant
(Selector_Name (Original_Node (Dval)), True)
then
exit Discr_Loop;
-- Do not retrieve value if constraint is not static. It
-- is generally not useful, and the constraint may be a
-- rewritten outer discriminant in which case it is in
-- fact incorrect.
elsif Is_Entity_Name (Dval)
and then Nkind (Parent (Entity (Dval)))
= N_Object_Declaration
and then Present (Expression (Parent (Entity (Dval))))
and then
not Is_Static_Expression
(Expression (Parent (Entity (Dval))))
then
exit Discr_Loop;
@ -7524,14 +7536,14 @@ package body Exp_Ch4 is
-- missing cases.
elsif Nkind (Parent (N)) = N_Case_Statement
and then Etype (Node (Dcon)) /= Etype (Disc)
and then Etype (Dval) /= Etype (Disc)
then
Rewrite (N,
Make_Qualified_Expression (Loc,
Subtype_Mark =>
New_Occurrence_Of (Etype (Disc), Loc),
Expression =>
New_Copy_Tree (Node (Dcon))));
New_Copy_Tree (Dval)));
Analyze_And_Resolve (N, Etype (Disc));
-- In case that comes out as a static expression,
@ -7548,7 +7560,7 @@ package body Exp_Ch4 is
-- yet, and this must be done now.
else
Rewrite (N, New_Copy_Tree (Node (Dcon)));
Rewrite (N, New_Copy_Tree (Dval));
Analyze_And_Resolve (N);
Set_Is_Static_Expression (N, False);
return;

12
gcc/ada/freeze.adb
View File

@ -5100,10 +5100,16 @@ package body Freeze is
-- issue an error message saying that this object cannot be imported
-- or exported. If it has an address clause it is an overlay in the
-- current partition and the static requirement is not relevant.
-- Do not issue any error message when ignoring rep clauses.
if Is_Imported (E) and then No (Address_Clause (E)) then
Error_Msg_N
("& cannot be imported (local type is not constant)", E);
if Ignore_Rep_Clauses then
null;
elsif Is_Imported (E) then
if No (Address_Clause (E)) then
Error_Msg_N
("& cannot be imported (local type is not constant)", E);
end if;
-- Otherwise must be exported, something is wrong if compiler
-- is marking something as statically allocated which cannot be).

6
gcc/ada/gnat1drv.adb
View File

@ -255,6 +255,12 @@ procedure Gnat1drv is
-- front-end warnings when we are getting CodePeer output.
Reset_Style_Check_Options;
-- Always perform semantics and generate ali files in CodePeer mode,
-- so that a gnatmake -c -k will proceed further when possible.
Force_ALI_Tree_File := True;
Try_Semantics := True;
end if;
-- Set Configurable_Run_Time mode if system.ads flag set

6
gcc/ada/prj-proc.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, 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- --
@ -460,6 +460,10 @@ package body Prj.Proc is
Lower : Boolean;
begin
if Index = All_Other_Names then
return Index;
end if;
Get_Name_String (Index);
Lower := Case_Insensitive (Attr, Tree);

28
gcc/ada/prj-strt.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, 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- --
@ -230,19 +230,35 @@ package body Prj.Strt is
if Token = Tok_Left_Paren then
Scan (In_Tree);
Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then
if Others_Allowed_For (Current_Attribute)
and then Token = Tok_Others
then
Set_Associative_Array_Index_Of
(Reference, In_Tree, To => Token_Name);
(Reference, In_Tree, To => All_Other_Names);
Scan (In_Tree);
Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
else
if Others_Allowed_For (Current_Attribute) then
Expect
(Tok_String_Literal, "literal string or others");
else
Expect (Tok_String_Literal, "literal string");
end if;
if Token = Tok_String_Literal then
Set_Associative_Array_Index_Of
(Reference, In_Tree, To => Token_Name);
Scan (In_Tree);
end if;
end if;
end if;
Expect (Tok_Right_Paren, "`)`");
if Token = Tok_Right_Paren then
Scan (In_Tree);
end if;
end if;
end if;

201
gcc/ada/sem_ch10.adb
View File

@ -219,9 +219,9 @@ package body Sem_Ch10 is
-- To support this feature, the analysis of a limited_with clause must
-- create an abbreviated view of the package, without performing any
-- semantic analysis on it. This "package abstract" contains shadow
-- types that are in one-one correspondence with the real types in the
-- package, and that have the properties of incomplete types.
-- semantic analysis on it. This "package abstract" contains shadow types
-- that are in one-one correspondence with the real types in the package,
-- and that have the properties of incomplete types.
-- The implementation creates two element lists: one to chain the shadow
-- entities, and one to chain the corresponding type entities in the tree
@ -310,12 +310,11 @@ package body Sem_Ch10 is
Use_Item : Node_Id;
function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean;
-- In an expanded name in a use clause, if the prefix is a
-- renamed package, the entity is set to the original package
-- as a result, when checking whether the package appears in a
-- previous with_clause, the renaming has to be taken into
-- account, to prevent spurious or incorrect warnings. The
-- common case is the use of Text_IO.
-- In an expanded name in a use clause, if the prefix is a renamed
-- package, the entity is set to the original package as a result,
-- when checking whether the package appears in a previous with
-- clause, the renaming has to be taken into account, to prevent
-- spurious/incorrect warnings. A common case is use of Text_IO.
---------------
-- Same_Unit --
@ -441,9 +440,9 @@ package body Sem_Ch10 is
Cont_Item := First (Context_List);
while Present (Cont_Item) loop
-- Stop the search since the context items after Cont_Item
-- have already been examined in a previous iteration of
-- the reverse loop in Check_Redundant_Withs.
-- Stop the search since the context items after Cont_Item have
-- already been examined in a previous iteration of the reverse
-- loop in Check_Redundant_Withs.
if Exit_On_Self
and Cont_Item = Clause
@ -466,10 +465,11 @@ package body Sem_Ch10 is
end loop;
-- Package with clause. Avoid processing self, implicitly
-- generated with clauses or limited with clauses. Note
-- that we examine with clauses having pragmas Elaborate
-- or Elaborate_All applied to them due to cases such as:
-- generated with clauses or limited with clauses. Note that
-- we examine with clauses having pragmas Elaborate or
-- Elaborate_All applied to them due to cases such as:
--
-- with Pack;
-- with Pack;
-- pragma Elaborate (Pack);
@ -496,9 +496,8 @@ package body Sem_Ch10 is
Clause := Last (Context_Items);
while Present (Clause) loop
-- Avoid checking implicitly generated with clauses, limited
-- with clauses or withs that have pragma Elaborate or
-- Elaborate_All applied.
-- Avoid checking implicitly generated with clauses, limited with
-- clauses or withs that have pragma Elaborate or Elaborate_All.
if Nkind (Clause) = N_With_Clause
and then not Implicit_With (Clause)
@ -642,9 +641,9 @@ package body Sem_Ch10 is
-- analysis of the parent, which we proceed to do. Basically this gets
-- handled from the top down and we don't want to do anything at this
-- level (i.e. this subunit will be handled on the way down from the
-- parent), so at this level we immediately return. If the subunit
-- ends up not analyzed, it means that the parent did not contain a
-- stub for it, or that there errors were detected in some ancestor.
-- parent), so at this level we immediately return. If the subunit ends
-- up not analyzed, it means that the parent did not contain a stub for
-- it, or that there errors were detected in some ancestor.
if Nkind (Unit_Node) = N_Subunit
and then not Analyzed (Lib_Unit)
@ -662,13 +661,13 @@ package body Sem_Ch10 is
return;
end if;
-- Analyze context (this will call Sem recursively for with'ed units)
-- To detect circularities among with-clauses that are not caught during
-- Analyze context (this will call Sem recursively for with'ed units) To
-- detect circularities among with-clauses that are not caught during
-- loading, we set the Context_Pending flag on the current unit. If the
-- flag is already set there is a potential circularity.
-- We exclude predefined units from this check because they are known
-- to be safe. We also exclude package bodies that are present because
-- circularities between bodies are harmless (and necessary).
-- flag is already set there is a potential circularity. We exclude
-- predefined units from this check because they are known to be safe.
-- We also exclude package bodies that are present because circularities
-- between bodies are harmless (and necessary).
if Context_Pending (N) then
declare
@ -979,9 +978,9 @@ package body Sem_Ch10 is
end if;
end if;
-- Remove unit from visibility, so that environment is clean for
-- the next compilation, which is either the main unit or some
-- other unit in the context.
-- Remove unit from visibility, so that environment is clean for the
-- next compilation, which is either the main unit or some other unit
-- in the context.
if Nkind_In (Unit_Node, N_Package_Declaration,
N_Package_Renaming_Declaration,
@ -994,8 +993,8 @@ package body Sem_Ch10 is
Remove_Unit_From_Visibility (Defining_Entity (Unit_Node));
-- If the unit is an instantiation whose body will be elaborated for
-- inlining purposes, use the proper entity of the instance. The
-- entity may be missing if the instantiation was illegal.
-- inlining purposes, use the proper entity of the instance. The entity
-- may be missing if the instantiation was illegal.
elsif Nkind (Unit_Node) = N_Package_Instantiation
and then not Error_Posted (Unit_Node)
@ -1580,10 +1579,10 @@ package body Sem_Ch10 is
Comp_Unit : Node_Id;
begin
-- Try to load subunit, but ignore any errors that occur during
-- the loading of the subunit, by using the special feature in
-- Errout to ignore all errors. Note that Fatal_Error will still
-- be set, so we will be able to check for this case below.
-- Try to load subunit, but ignore any errors that occur during the
-- loading of the subunit, by using the special feature in Errout to
-- ignore all errors. Note that Fatal_Error will still be set, so we
-- will be able to check for this case below.
if not ASIS_Mode then
Ignore_Errors_Enable := Ignore_Errors_Enable + 1;
@ -1713,9 +1712,9 @@ package body Sem_Ch10 is
return;
-- If the subunit is not already loaded, and we are generating code,
-- then this is the case where compilation started from the parent,
-- and we are generating code for an entire subunit tree. In that
-- case we definitely need to load the subunit.
-- then this is the case where compilation started from the parent, and
-- we are generating code for an entire subunit tree. In that case we
-- definitely need to load the subunit.
-- In order to continue the analysis with the rest of the parent,
-- and other subunits, we load the unit without requiring its
@ -1724,13 +1723,13 @@ package body Sem_Ch10 is
elsif Original_Operating_Mode = Generate_Code then
-- If the proper body is already linked to the stub node,
-- the stub is in a generic unit and just needs analyzing.
-- If the proper body is already linked to the stub node, the stub is
-- in a generic unit and just needs analyzing.
-- We update the version. Although we are not technically
-- semantically dependent on the subunit, given our approach
-- of macro substitution of subunits, it makes sense to
-- include it in the version identification.
-- We update the version. Although we are not strictly technically
-- semantically dependent on the subunit, given our approach of macro
-- substitution of subunits, it makes sense to include it in the
-- version identification.
if Present (Library_Unit (N)) then
Set_Corresponding_Stub (Unit (Library_Unit (N)), N);
@ -1747,9 +1746,8 @@ package body Sem_Ch10 is
Subunit => True,
Error_Node => N);
-- Give message if we did not get the unit
-- Emit warning even if missing subunit is not
-- within main unit, to simplify debugging.
-- Give message if we did not get the unit Emit warning even if
-- missing subunit is not within main unit, to simplify debugging.
if Original_Operating_Mode = Generate_Code
and then Unum = No_Unit
@ -1763,8 +1761,8 @@ package body Sem_Ch10 is
end if;
-- Load_Unit may reset Compiler_State, since it may have been
-- necessary to parse an additional units, so we make sure
-- that we reset it to the Analyzing state.
-- necessary to parse an additional units, so we make sure that
-- we reset it to the Analyzing state.
Compiler_State := Analyzing;
@ -2618,9 +2616,9 @@ package body Sem_Ch10 is
Sub_Parent := Library_Unit (N);
Curr_Unit := Defining_Entity (Unit (Library_Unit (Sub_Parent)));
-- If the parent itself is a subunit, Curr_Unit is the entity
-- of the enclosing body, retrieve the spec entity which is
-- the proper ancestor we need for the following tests.
-- If the parent itself is a subunit, Curr_Unit is the entity of the
-- enclosing body, retrieve the spec entity which is the proper
-- ancestor we need for the following tests.
if Ekind (Curr_Unit) = E_Package_Body then
Curr_Unit := Spec_Entity (Curr_Unit);
@ -2787,17 +2785,17 @@ package body Sem_Ch10 is
begin
if Nkind (Nam) = N_Identifier then
-- If the parent unit P in the name of the with_clause for P.Q
-- is a renaming of package R, then the entity of the parent is
-- set to R, but the identifier retains Chars (P) to be consistent
-- with the source (see details in lib-load). However, the
-- implicit_with_clause for the parent must make the entity for
-- P visible, because P.Q may be used as a prefix within the
-- current unit. The entity for P is the current_entity with that
-- name, because the package renaming declaration for it has just
-- been analyzed. Note that this case can only happen if P.Q has
-- already appeared in a previous with_clause in a related unit,
-- such as the library body of the current unit.
-- If the parent unit P in the name of the with_clause for P.Q is
-- a renaming of package R, then the entity of the parent is set
-- to R, but the identifier retains Chars (P) to be consistent
-- with the source (see details in lib-load). However the implicit
-- with_clause for the parent must make the entity for P visible,
-- because P.Q may be used as a prefix within the current unit.
-- The entity for P is the current_entity with that name, because
-- the package renaming declaration for it has just been analyzed.
-- Note that this case can only happen if P.Q has already appeared
-- in a previous with_clause in a related unit, such as the
-- library body of the current unit.
if Chars (Nam) /= Chars (Entity (Nam)) then
Renaming := Current_Entity (Nam);
@ -2817,10 +2815,10 @@ package body Sem_Ch10 is
Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam))))
= N_Package_Renaming_Declaration
then
-- The name in the with_clause is of the form A.B.C, and B
-- is given by a renaming declaration. In that case we may
-- not have analyzed the unit for B, but replaced it directly
-- in lib-load with the unit it renames. We have to make A.B
-- The name in the with_clause is of the form A.B.C, and B is
-- given by a renaming declaration. In that case we may not
-- have analyzed the unit for B, but replaced it directly in
-- lib-load with the unit it renames. We have to make A.B
-- visible, so analyze the declaration for B now, in case it
-- has not been done yet.
@ -3630,9 +3628,9 @@ package body Sem_Ch10 is
Subunit => False,
Error_Node => Nam);
-- Do not generate a limited_with_clause on the current unit.
-- This path is taken when a unit has a limited_with clause on
-- one of its child units.
-- Do not generate a limited_with_clause on the current unit. This
-- path is taken when a unit has a limited_with clause on one of its
-- child units.
if Unum = Current_Sem_Unit then
return;
@ -3730,8 +3728,8 @@ package body Sem_Ch10 is
Next (Item);
end loop;
-- Ada 2005 (AI-412): Examine the visible declarations of a package
-- spec, looking for incomplete subtype declarations of incomplete types
-- Ada 2005 (AI-412): Examine visible declarations of a package spec,
-- looking for incomplete subtype declarations of incomplete types
-- visible through a limited with clause.
if Ada_Version >= Ada_05
@ -3760,7 +3758,7 @@ package body Sem_Ch10 is
-- Convert an incomplete subtype declaration into a
-- corresponding non-limited view subtype declaration.
-- This is usually the case when analyzing a body that
-- has regular with-clauses, when the spec has limited
-- has regular with clauses, when the spec has limited
-- ones.
-- If the non-limited view is still incomplete, it is
@ -4345,8 +4343,8 @@ package body Sem_Ch10 is
end loop;
end;
-- Finally, check whether there are subprograms that still
-- require a body, i.e. are not renamings or null.
-- Finally, check whether there are subprograms that still require
-- a body, i.e. are not renamings or null.
if not Is_Empty_Elmt_List (Subp_List) then
declare
@ -4438,8 +4436,8 @@ package body Sem_Ch10 is
return True;
end if;
-- If there are more ancestors, climb up the tree, otherwise
-- we are done.
-- If there are more ancestors, climb up the tree, otherwise we
-- are done.
if Is_Child_Unit (Par) then
Par := Scope (Par);
@ -4596,10 +4594,10 @@ package body Sem_Ch10 is
-- Do not install the limited view if this is the unit being analyzed.
-- This unusual case will happen when a unit has a limited_with clause
-- on one of its children. The compilation of the child forces the
-- load of the parent which tries to install the limited view of the
-- child again. Installing the limited view must also be disabled
-- when compiling the body of the child unit.
-- on one of its children. The compilation of the child forces the load
-- of the parent which tries to install the limited view of the child
-- again. Installing the limited view must also be disabled when
-- compiling the body of the child unit.
if P = Cunit_Entity (Current_Sem_Unit)
or else
@ -4609,11 +4607,11 @@ package body Sem_Ch10 is
return;
end if;
-- This scenario is similar to the one above, the difference is that
-- the compilation of sibling Par.Sib forces the load of parent Par
-- which tries to install the limited view of Lim_Pack [1]. However
-- Par.Sib has a with clause for Lim_Pack [2] in its body, and thus
-- needs the non-limited views of all entities from Lim_Pack.
-- This scenario is similar to the one above, the difference is that the
-- compilation of sibling Par.Sib forces the load of parent Par which
-- tries to install the limited view of Lim_Pack [1]. However Par.Sib
-- has a with clause for Lim_Pack [2] in its body, and thus needs the
-- non-limited views of all entities from Lim_Pack.
-- limited with Lim_Pack; -- [1]
-- package Par is ... package Lim_Pack is ...
@ -4642,9 +4640,8 @@ package body Sem_Ch10 is
return;
end if;
-- A common use of the limited-with is to have a limited-with
-- in the package spec, and a normal with in its package body.
-- For example:
-- A common use of the limited-with is to have a limited-with in the
-- package spec, and a normal with in its package body. For example:
-- limited with X; -- [1]
-- package A is ...
@ -4775,8 +4772,8 @@ package body Sem_Ch10 is
Prev := Current_Entity (Lim_Typ);
E := Prev;
-- Replace E in the homonyms list, so that the limited
-- view becomes available.
-- Replace E in the homonyms list, so that the limited view
-- becomes available.
if E = Non_Limited_View (Lim_Typ) then
Set_Homonym (Lim_Typ, Homonym (Prev));
@ -4786,8 +4783,8 @@ package body Sem_Ch10 is
loop
E := Homonym (Prev);
-- E may have been removed when installing a
-- previous limited_with_clause.
-- E may have been removed when installing a previous
-- limited_with_clause.
exit when No (E);
@ -4829,10 +4826,10 @@ package body Sem_Ch10 is
Check_Body_Required;
end if;
-- If the package in the limited_with clause is a child unit, the
-- clause is unanalyzed and appears as a selected component. Recast
-- it as an expanded name so that the entity can be properly set. Use
-- entity of parent, if available, for higher ancestors in the name.
-- If the package in the limited_with clause is a child unit, the clause
-- is unanalyzed and appears as a selected component. Recast it as an
-- expanded name so that the entity can be properly set. Use entity of
-- parent, if available, for higher ancestors in the name.
if Nkind (Name (N)) = N_Selected_Component then
declare
@ -5763,10 +5760,10 @@ package body Sem_Ch10 is
Write_Eol;
end if;
-- Prepare the removal of the shadow entities from visibility. The
-- first element of the limited view is a header (an E_Package
-- entity) that is used to reference the first shadow entity in the
-- private part of the package
-- Prepare the removal of the shadow entities from visibility. The first
-- element of the limited view is a header (an E_Package entity) that is
-- used to reference the first shadow entity in the private part of the
-- package
Lim_Header := Limited_View (P);
Lim_Typ := First_Entity (Lim_Header);