* [COMMITTED] ada: Add Is_Past_Self_Hiding_Point flag
@ 2023-05-22 8:50 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-22 8:50 UTC (permalink / raw)
To: gcc-patches; +Cc: Bob Duff
From: Bob Duff <duff@adacore.com>
This patch adds a flag Is_Past_Self_Hiding_Point. When False,
this will replace E_Void as the indicator for a premature use of
a declaration within itself -- for example, "X : T := X;".
One might think this flag should be called something like
Is_Hidden_From_All_Visibility, reversing the sense of
Is_Past_Self_Hiding_Point. We don't do that because we want
Is_Past_Self_Hiding_Point to be initially False by default (and we have
no mechanism for defaulting to True), and because it doesn't exactly
match the RM definition of "hidden from all visibility" (for
example, for record components).
This is work in progress; more changes are needed before we
can remove all Mutate_Ekind(..., E_Void).
gcc/ada/
* einfo.ads (Is_Past_Self_Hiding_Point): Document.
* gen_il-fields.ads (Is_Past_Self_Hiding_Point): Add to list of
fields.
* gen_il-gen-gen_entities.adb (Is_Past_Self_Hiding_Point): Declare
in all entities.
* exp_aggr.adb: Set Is_Past_Self_Hiding_Point as appropriate.
* sem.adb: Likewise.
* sem_aggr.adb: Likewise.
* sem_ch11.adb: Likewise.
* sem_ch12.adb: Likewise.
* sem_ch5.adb: Likewise.
* sem_ch7.adb: Likewise.
* sem_prag.adb: Likewise.
* sem_ch6.adb: Likewise.
(Set_Formal_Mode): Minor cleanup: Move from spec.
* sem_ch6.ads:
(Set_Formal_Mode): Minor cleanup: Move to body.
* cstand.adb: Call Set_Is_Past_Self_Hiding_Point on all entities
as soon as they are created.
* comperr.adb (Compiler_Abort): Minor cleanup -- use 'in' instead
of 'or else'.
* debug.adb: Minor comment cleanups.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/comperr.adb | 6 ++----
gcc/ada/cstand.adb | 4 +++-
gcc/ada/debug.adb | 23 +++++++++++++----------
gcc/ada/einfo.ads | 13 +++++++++++++
gcc/ada/exp_aggr.adb | 1 +
gcc/ada/gen_il-fields.ads | 1 +
gcc/ada/gen_il-gen-gen_entities.adb | 1 +
gcc/ada/sem.adb | 23 +++++++++++++++++++++++
gcc/ada/sem_aggr.adb | 3 +++
gcc/ada/sem_ch11.adb | 1 +
gcc/ada/sem_ch12.adb | 5 +++++
gcc/ada/sem_ch5.adb | 4 ++++
gcc/ada/sem_ch6.adb | 8 ++++++++
gcc/ada/sem_ch6.ads | 3 ---
gcc/ada/sem_ch7.adb | 9 ++++++---
gcc/ada/sem_prag.adb | 9 +++++----
16 files changed, 89 insertions(+), 25 deletions(-)
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb
index 4fc0e5d3baa..c52db7b0c23 100644
--- a/gcc/ada/comperr.adb
+++ b/gcc/ada/comperr.adb
@@ -177,10 +177,8 @@ package body Comperr is
-- Output target name, deleting junk final reverse slash
- if Target_Name.all (Target_Name.all'Last) = '\'
- or else Target_Name.all (Target_Name.all'Last) = '/'
- then
- Write_Str (Target_Name.all (1 .. Target_Name.all'Last - 1));
+ if Target_Name (Target_Name'Last) in '/' | '\' then
+ Write_Str (Target_Name (1 .. Target_Name'Last - 1));
else
Write_Str (Target_Name.all);
end if;
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 72c287a8739..f53015d1e0c 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -1784,6 +1784,7 @@ package body CStand is
Set_Is_Immediately_Visible (Ident_Node, True);
Set_Is_Intrinsic_Subprogram (Ident_Node, True);
+ Set_Is_Past_Self_Hiding_Point (Ident_Node);
Set_Name_Entity_Id (Op, Ident_Node);
Append_Entity (Ident_Node, Standard_Standard);
@@ -1806,9 +1807,10 @@ package body CStand is
Set_Is_Public (E);
-- All standard entity names are analyzed manually, and are thus
- -- frozen as soon as they are created.
+ -- frozen and not self-hidden as soon as they are created.
Set_Is_Frozen (E);
+ Set_Is_Past_Self_Hiding_Point (E);
-- Set debug information required for all standard types
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 7497fa04076..9566e095d1a 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -41,7 +41,7 @@ package body Debug is
-- dh Generate listing showing loading of name table hash chains
-- di Generate messages for visibility linking/delinking
-- dj Suppress "junk null check" for access parameter values
- -- dk Generate GNATBUG message on abort, even if previous errors
+ -- dk Generate "GNAT BUG" message on abort, even if previous errors
-- dl Generate unit load trace messages
-- dm Prevent special frontend inlining in GNATprove mode
-- dn Generate messages for node/list allocation
@@ -113,7 +113,7 @@ package body Debug is
-- d.z Restore previous support for frontend handling of Inline_Always
-- d.A Enable statistics printing in Atree
- -- d.B Generate a bug box on abort_statement
+ -- d.B Generate a "GNAT BUG" message on abort_statement
-- d.C Generate concatenation call, do not generate inline code
-- d.D Disable errors on use of overriding keyword in Ada 95 mode
-- d.E Turn selected errors into warnings
@@ -486,9 +486,12 @@ package body Debug is
-- GNAT before 3.10, so this switch can ease the transition process.
-- dk Immediate kill on abort. Normally on an abort (i.e. a call to
- -- Comperr.Compiler_Abort), the GNATBUG message is not given if
- -- there is a previous error. This debug switch bypasses this test
- -- and gives the message unconditionally (useful for debugging).
+ -- Comperr.Compiler_Abort), the "GNAT BUG" message is not given if
+ -- there is a previous error. Instead, the message "compilation
+ -- abandoned due to previous error" is given. This debug switch
+ -- bypasses this test and gives the "GNAT BUG" message unconditionally
+ -- (useful for debugging). Use -gnatdO in addition to see the previous
+ -- errors.
-- dl Generate unit load trace messages. A line of traceback output is
-- generated each time a request is made to the library manager to
@@ -835,12 +838,12 @@ package body Debug is
-- with -gnatd.A. You might want to apply "sort -nr" to parts of the
-- output.
- -- d.B Generate a bug box when we see an abort_statement, even though
- -- there is no bug. Useful for testing Comperr.Compiler_Abort: write
- -- some code containing an abort_statement, and compile it with
+ -- d.B Generate a "GNAT BUG" message when we see an abort_statement, even
+ -- though there is no bug. Useful for testing Comperr.Compiler_Abort:
+ -- write some code containing an abort_statement, and compile it with
-- -gnatd.B. There is nothing special about abort_statements; it just
- -- provides a way to control where the bug box is generated. See "when
- -- N_Abort_Statement" in package body Expander.
+ -- provides a way to control where the bug box is generated. See the
+ -- "when N_Abort_Statement" in package body Expander.
-- d.C Generate call to System.Concat_n.Str_Concat_n routines in cases
-- where we would normally generate inline concatenation code.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6748533a32c..c67731c1298 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3104,6 +3104,18 @@ package Einfo is
-- procedure which verifies the invariants of the partial view of a
-- private type or private extension.
+-- Is_Past_Self_Hiding_Point
+-- Defined in all entities. Roughly speaking, this is False if the
+-- declaration of the entity is hidden from all visibility because
+-- we are within its declaration, as defined by 8.3(16-18). When
+-- we reach the end of the declaration or other place defined by
+-- 8.3(16-18), this is set to True. However, this flag is not used
+-- for most overloaded declarations (but is used for enumeration
+-- literals), and is also used for other cases of premature usage
+-- such as defined in 3.8(10) for record components and the like.
+-- In addition, there are cases involving discriminants where we
+-- set this True, then temporarily False again.
+
-- Is_Potentially_Use_Visible
-- Defined in all entities. Set if entity is potentially use visible,
-- i.e. it is defined in a package that appears in a currently active
@@ -4945,6 +4957,7 @@ package Einfo is
-- Is_Obsolescent
-- Is_Package_Body_Entity
-- Is_Packed_Array_Impl_Type
+ -- Is_Past_Self_Hiding_Point
-- Is_Potentially_Use_Visible
-- Is_Preelaborated
-- Is_Primitive_Wrapper
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index e4b1991f410..e2f0ccdb34a 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2057,6 +2057,7 @@ package body Exp_Aggr is
Set_Etype (L_J, Any_Type);
Mutate_Ekind (L_J, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (L_J);
Set_Scope (L_J, Ent);
else
L_J := Make_Temporary (Loc, 'J', L);
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 582837cb7ec..19ebf6744d0 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -752,6 +752,7 @@ package Gen_IL.Fields is
Is_Package_Body_Entity,
Is_Packed,
Is_Packed_Array_Impl_Type,
+ Is_Past_Self_Hiding_Point,
Is_Param_Block_Component_Type,
Is_Partial_Invariant_Procedure,
Is_Potentially_Use_Visible,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index 9f71b7d2b4e..6356de0ee2e 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -177,6 +177,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Is_Package_Body_Entity, Flag),
Sm (Is_Packed, Flag, Impl_Base_Type_Only),
Sm (Is_Packed_Array_Impl_Type, Flag),
+ Sm (Is_Past_Self_Hiding_Point, Flag),
Sm (Is_Potentially_Use_Visible, Flag),
Sm (Is_Preelaborated, Flag),
Sm (Is_Private_Descendant, Flag),
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 9c338d33496..b0b492b0099 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -760,6 +760,29 @@ package body Sem is
Debug_A_Exit ("analyzing ", N, " (done)");
+ -- Set Is_Past_Self_Hiding_Point flag. RM-8.3(16) says a declaration
+ -- is no longer hidden from all visibility after "the end of the
+ -- declaration", so we set the flag here (in addition to setting it
+ -- elsewhere to handle the "except..." cases of 8.3(16)). However,
+ -- we implement 3.8(10) using the same flag, so in that case we
+ -- need to defer the setting until the end of the record.
+
+ declare
+ E : constant Entity_Id := Defining_Entity_Or_Empty (N);
+ begin
+ if Present (E) then
+ if Ekind (E) = E_Void
+ and then Nkind (N) = N_Component_Declaration
+ and then Present (Scope (E))
+ and then Ekind (Scope (E)) = E_Record_Type
+ then
+ null; -- Set it later, in Analyze_Component_Declaration
+ elsif not Is_Past_Self_Hiding_Point (E) then
+ Set_Is_Past_Self_Hiding_Point (E);
+ end if;
+ end if;
+ end;
+
-- Mark relevant use-type and use-package clauses as effective
-- preferring the original node over the analyzed one in the case that
-- constant folding has occurred and removed references that need to be
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index c037201885e..bd01903a2d2 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1844,6 +1844,7 @@ package body Sem_Aggr is
Set_Etype (Id, Index_Typ);
Mutate_Ekind (Id, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Id);
Set_Scope (Id, Scop);
end if;
@@ -3132,6 +3133,7 @@ package body Sem_Aggr is
end if;
Mutate_Ekind (Id, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Id);
Set_Scope (Id, Ent);
Set_Referenced (Id);
@@ -3504,6 +3506,7 @@ package body Sem_Aggr is
if No (Scope (Id)) then
Set_Etype (Id, Index_Type);
Mutate_Ekind (Id, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Id);
Set_Scope (Id, Ent);
end if;
Enter_Name (Id);
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index 70fd334613c..d07c480b042 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -234,6 +234,7 @@ package body Sem_Ch11 is
Enter_Name (Choice);
Mutate_Ekind (Choice, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Choice);
if RTE_Available (RE_Exception_Occurrence) then
Set_Etype (Choice, RTE (RE_Exception_Occurrence));
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index d37a82502fc..7191e42fecb 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3186,6 +3186,7 @@ package body Sem_Ch12 is
Renaming_In_Par :=
Make_Defining_Identifier (Loc, Chars (Gen_Unit));
Mutate_Ekind (Renaming_In_Par, E_Package);
+ Set_Is_Past_Self_Hiding_Point (Renaming_In_Par);
Set_Etype (Renaming_In_Par, Standard_Void_Type);
Set_Scope (Renaming_In_Par, Parent_Instance);
Set_Parent (Renaming_In_Par, Parent (Formal));
@@ -3846,6 +3847,7 @@ package body Sem_Ch12 is
Enter_Name (Id);
Mutate_Ekind (Id, E_Generic_Package);
+ Set_Is_Past_Self_Hiding_Point (Id);
Set_Etype (Id, Standard_Void_Type);
-- Set SPARK_Mode from context
@@ -4093,6 +4095,8 @@ package body Sem_Ch12 is
Set_Etype (Id, Standard_Void_Type);
end if;
+ Set_Is_Past_Self_Hiding_Point (Id);
+
-- Analyze the aspects of the generic copy to ensure that all generated
-- pragmas (if any) perform their semantic effects.
@@ -4336,6 +4340,7 @@ package body Sem_Ch12 is
Generate_Definition (Act_Decl_Id);
Mutate_Ekind (Act_Decl_Id, E_Package);
+ Set_Is_Past_Self_Hiding_Point (Act_Decl_Id);
-- Initialize list of incomplete actuals before analysis
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 27ab0b738cd..4919e5372ac 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2374,6 +2374,7 @@ package body Sem_Ch5 is
-- iterator name.
Mutate_Ekind (Def_Id, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Def_Id);
-- Provide a link between the iterator variable and the container, for
-- subsequent use in cross-reference and modification information.
@@ -2652,6 +2653,7 @@ package body Sem_Ch5 is
else
Mutate_Ekind (Def_Id, E_Loop_Parameter);
+ Set_Is_Past_Self_Hiding_Point (Def_Id);
Error_Msg_Ada_2012_Feature ("container iterator", Sloc (N));
-- OF present
@@ -2705,6 +2707,7 @@ package body Sem_Ch5 is
if Has_Aspect (Typ, Aspect_Variable_Indexing) then
Mutate_Ekind (Def_Id, E_Variable);
+ Set_Is_Past_Self_Hiding_Point (Def_Id);
end if;
-- If the container is a constant, iterating over it
@@ -3329,6 +3332,7 @@ package body Sem_Ch5 is
end if;
Mutate_Ekind (Id, E_Loop_Parameter);
+ Set_Is_Past_Self_Hiding_Point (Id);
-- A quantified expression which appears in a pre- or post-condition may
-- be analyzed multiple times. The analysis of the range creates several
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ba88c07e8a4..df069670ad0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -226,6 +226,10 @@ package body Sem_Ch6 is
-- Preanalysis of default expressions of subprogram formals. N is the
-- expression to be analyzed and T is the expected type.
+ procedure Set_Formal_Mode (Formal_Id : Entity_Id);
+ -- Set proper Ekind to reflect formal mode (in, out, in out), and set
+ -- miscellaneous other attributes.
+
procedure Set_Formal_Validity (Formal_Id : Entity_Id);
-- Formal_Id is an formal parameter entity. This procedure deals with
-- setting the proper validity status for this entity, which depends on
@@ -5241,6 +5245,8 @@ package body Sem_Ch6 is
Set_Etype (Designator, Standard_Void_Type);
end if;
+ Set_Is_Past_Self_Hiding_Point (Designator);
+
-- Flag Is_Inlined_Always is True by default, and reversed to False for
-- those subprograms which could be inlined in GNATprove mode (because
-- Body_To_Inline is non-Empty) but should not be inlined.
@@ -13421,6 +13427,8 @@ package body Sem_Ch6 is
Mutate_Ekind (Formal_Id, E_In_Parameter);
end if;
+ Set_Is_Past_Self_Hiding_Point (Formal_Id);
+
-- Set Is_Known_Non_Null for access parameters since the language
-- guarantees that access parameters are always non-null. We also set
-- Can_Never_Be_Null, since there is no way to change the value.
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index b3dc82f51c8..f5ff960d47c 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -282,9 +282,6 @@ package Sem_Ch6 is
-- during execution of the subprogram. By setting the actual subtype
-- once, we avoid recomputing it unnecessarily.
- procedure Set_Formal_Mode (Formal_Id : Entity_Id);
- -- Set proper Ekind to reflect formal mode (in, out, in out)
-
function Subtype_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index e8eb652c0ea..fe0429a2044 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1187,6 +1187,8 @@ package body Sem_Ch7 is
Generate_Definition (Id);
Enter_Name (Id);
Mutate_Ekind (Id, E_Package);
+ Set_Is_Past_Self_Hiding_Point (Id);
+ -- Needed early because of Set_Categorization_From_Pragmas below
Set_Etype (Id, Standard_Void_Type);
-- Set SPARK_Mode from context
@@ -2727,10 +2729,11 @@ package body Sem_Ch7 is
Mutate_Ekind (Id, E_Private_Type);
end if;
- Set_Etype (Id, Id);
+ Set_Is_Past_Self_Hiding_Point (Id);
+ Set_Etype (Id, Id);
Set_Has_Delayed_Freeze (Id);
- Set_Is_First_Subtype (Id);
- Reinit_Size_Align (Id);
+ Set_Is_First_Subtype (Id);
+ Reinit_Size_Align (Id);
Set_Is_Constrained (Id,
No (Discriminant_Specifications (N))
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index feaf486c348..ba4c75e7c96 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -12202,10 +12202,11 @@ package body Sem_Prag is
-- Null states never come from source
- Set_Comes_From_Source (State_Id, not Is_Null);
- Set_Parent (State_Id, State);
- Mutate_Ekind (State_Id, E_Abstract_State);
- Set_Etype (State_Id, Standard_Void_Type);
+ Set_Comes_From_Source (State_Id, not Is_Null);
+ Set_Parent (State_Id, State);
+ Mutate_Ekind (State_Id, E_Abstract_State);
+ Set_Is_Past_Self_Hiding_Point (State_Id);
+ Set_Etype (State_Id, Standard_Void_Type);
Set_Encapsulating_State (State_Id, Empty);
-- Set the SPARK mode from the current context
--
2.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-22 8:50 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-22 8:50 [COMMITTED] ada: Add Is_Past_Self_Hiding_Point flag Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).