From d606f1df142db414d00e0089acb76f4d29caf441 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 10 Aug 2010 15:43:01 +0200 Subject: [PATCH] [multiple changes] 2010-08-10 Robert Dewar * 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 * 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 * 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 * 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 --- gcc/ada/ChangeLog | 28 ++++++ gcc/ada/a-suenco.adb | 8 +- gcc/ada/exp_ch4.adb | 48 +++++++---- gcc/ada/freeze.adb | 12 ++- gcc/ada/gnat1drv.adb | 6 ++ gcc/ada/prj-proc.adb | 6 +- gcc/ada/prj-strt.adb | 28 ++++-- gcc/ada/sem_ch10.adb | 201 +++++++++++++++++++++---------------------- 8 files changed, 203 insertions(+), 134 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2715b54782cb..6c8e23dba4fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2010-08-10 Robert Dewar + + * 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 + + * 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 + + * 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 + + * 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 * exp_attr.adb: Add comments. diff --git a/gcc/ada/a-suenco.adb b/gcc/ada/a-suenco.adb index 42b7f719a5ba..24c0231061d6 100755 --- a/gcc/ada/a-suenco.adb +++ b/gcc/ada/a-suenco.adb @@ -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#)); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 2b3c28b0994b..0e7af41de90d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9a22ff7bcf86..8a48f9ca78d2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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). diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 414d61446f40..7af2d6436eba 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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 diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 5859a8afe823..65d019015c18 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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); diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index 0dd2e5eeabd5..9798fb9c60af 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -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; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 1ce76e89c25a..30ce4ba7aea3 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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); -- 2.43.5