From 78c0f016063f856d4d35ba5591fbe825d7ab6544 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 19 Mar 2012 17:29:27 +0100 Subject: [PATCH] [multiple changes] 2012-03-19 Hristian Kirtchev * sem_ch3.adb (Get_Discriminant_Value): Instead of looking at the immediate correcponsing discriminant, traverse a potential chain of discriminants produced by type derivations. (Root_Corresponding_Discriminant): Traverse a chain of inherited discriminants and return the topmost discriminant. 2012-03-19 Bob Duff * debug.adb: Minor comment change. * gnat_ugn.texi: Update documentation for elaboration regarding indirect calls. 2012-03-19 Gary Dismukes * exp_ch3.adb (Expand_N_Object_Declaration): In the case of an object of a class-wide interface type, where the declaration is rewritten as a renaming, call Set_Debug_Info_Needed on the renaming entity so that Materialize_Entity will be set. Also, change existing call (for other than interface cases) to call Set_Debug_Info_Needed rather than Set_Needs_Debug_Info (as specified for that flag). From-SVN: r185526 --- gcc/ada/ChangeLog | 24 +++++++++++++++++++++ gcc/ada/debug.adb | 3 ++- gcc/ada/exp_ch3.adb | 13 +++++++++++- gcc/ada/gnat_ugn.texi | 49 ++++++++++++++----------------------------- gcc/ada/sem_ch3.adb | 26 +++++++++++++++++++++-- 5 files changed, 78 insertions(+), 37 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 956ff44e759..5966f5ef7d9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-03-19 Hristian Kirtchev + + * sem_ch3.adb (Get_Discriminant_Value): Instead of looking + at the immediate correcponsing discriminant, traverse a + potential chain of discriminants produced by type derivations. + (Root_Corresponding_Discriminant): Traverse a chain of inherited + discriminants and return the topmost discriminant. + +2012-03-19 Bob Duff + + * debug.adb: Minor comment change. + * gnat_ugn.texi: Update documentation for elaboration regarding + indirect calls. + +2012-03-19 Gary Dismukes + + * exp_ch3.adb (Expand_N_Object_Declaration): In + the case of an object of a class-wide interface type, where the + declaration is rewritten as a renaming, call Set_Debug_Info_Needed + on the renaming entity so that Materialize_Entity will be + set. Also, change existing call (for other than interface cases) + to call Set_Debug_Info_Needed rather than Set_Needs_Debug_Info + (as specified for that flag). + 2012-03-19 Hristian Kirtchev * sem_ch4.adb (Analyze_Allocator): Detect an allocator generated diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index a4207044297..032ba9dfe1e 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -646,7 +646,8 @@ package body Debug is -- elaboration model is conservative, especially regarding indirect -- calls. If you say Proc'Access, it will assume you might call -- Proc. This can cause elaboration cycles at bind time. This flag - -- reverts to the behavior of earlier compilers. + -- reverts to the behavior of earlier compilers, which ignored + -- indirect calls. -- d.W Print out debugging information for Walk_Library_Items, including -- the order in which units are walked. This is primarily for use in diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 41fc6f36b8c..9f6e5653911 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4820,6 +4820,17 @@ package body Exp_Ch3 is Subtype_Mark => New_Occurrence_Of (Typ, Loc), Name => Convert_Tag_To_Interface (Typ, Tag_Comp))); + -- If the original entity comes from source, then mark the + -- new entity as needing debug information, even though it's + -- defined by a generated renaming that does not come from + -- source, so that Materialize_Entity will be set on the + -- entity when Debug_Renaming_Declaration is called during + -- analysis. + + if Comes_From_Source (Def_Id) then + Set_Debug_Info_Needed (Defining_Identifier (N)); + end if; + Analyze (N, Suppress => All_Checks); -- Replace internal identifier of rewritten node by the @@ -5065,7 +5076,7 @@ package body Exp_Ch3 is -- renaming that does not come from source. if Comes_From_Source (Defining_Identifier (N)) then - Set_Needs_Debug_Info (Defining_Identifier (N)); + Set_Debug_Info_Needed (Defining_Identifier (N)); end if; -- Now call the routine to generate debug info for the renaming diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b8539f03d47..9022276aee0 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -601,7 +601,7 @@ Elaboration Order Handling in GNAT * Elaboration Issues for Library Tasks:: * Mixing Elaboration Models:: * What to Do If the Default Elaboration Behavior Fails:: -* Elaboration for Access-to-Subprogram Values:: +* Elaboration for Dispatching Calls:: * Summary of Procedures for Elaboration Control:: * Other Elaboration Order Considerations:: @@ -23279,7 +23279,7 @@ elaboration code in your own application). * Elaboration Issues for Library Tasks:: * Mixing Elaboration Models:: * What to Do If the Default Elaboration Behavior Fails:: -* Elaboration for Access-to-Subprogram Values:: +* Elaboration for Dispatching Calls:: * Summary of Procedures for Elaboration Control:: * Other Elaboration Order Considerations:: @end menu @@ -24936,39 +24936,22 @@ elaboration switch if your code is correct, and we assume that the C-tests are indeed correct (it is less efficient, but efficiency is not a factor in running the ACVC tests.) -@node Elaboration for Access-to-Subprogram Values -@section Elaboration for Access-to-Subprogram Values -@cindex Access-to-subprogram - -@noindent -Access-to-subprogram types (introduced in Ada 95) complicate -the handling of elaboration. The trouble is that it becomes -impossible to tell at compile time which procedure -is being called. This means that it is not possible for the binder -to analyze the elaboration requirements in this case. - -If at the point at which the access value is created -(i.e., the evaluation of @code{P'Access} for a subprogram @code{P}), -the body of the subprogram is -known to have been elaborated, then the access value is safe, and its use -does not require a check. This may be achieved by appropriate arrangement -of the order of declarations if the subprogram is in the current unit, -or, if the subprogram is in another unit, by using pragma -@code{Pure}, @code{Preelaborate}, or @code{Elaborate_Body} -on the referenced unit. - -If the referenced body is not known to have been elaborated at the point -the access value is created, then any use of the access value must do a -dynamic check, and this dynamic check will fail and raise a -@code{Program_Error} exception if the body has not been elaborated yet. -GNAT will generate the necessary checks, and in addition, if the -@option{-gnatwl} -switch is set, will generate warnings that such checks are required. +@node Elaboration for Dispatching Calls +@section Elaboration for Dispatching Calls +@cindex Dispatching calls -The use of dynamic dispatching for tagged types similarly generates -a requirement for dynamic checks, and premature calls to any primitive +@noindent +In rare cases, the static elaboration model fails to prevent +dispatching calls to not-yet-elaborated subprograms. In such cases, we +fall back to run-time checks; premature calls to any primitive operation of a tagged type before the body of the operation has been -elaborated, will result in the raising of @code{Program_Error}. +elaborated will raise @code{Program_Error}. + +Access-to-subprogram types, however, are handled conservatively, and +do not require run-time checks. This was not true in earlier versions +of the compiler; you can use the @option{-gnatd.U} debug switch to +revert to the old behavior if the new conservative behavior causes +elaboration cycles. @node Summary of Procedures for Elaboration Control @section Summary of Procedures for Elaboration Control diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 71b1fb44f3f..443c2d1048b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15601,6 +15601,11 @@ package body Sem_Ch3 is Typ_For_Constraint : Entity_Id; Constraint : Elist_Id) return Node_Id is + function Root_Corresponding_Discriminant + (Discr : Entity_Id) return Entity_Id; + -- Given a discriminant, traverse the chain of inherited discriminants + -- and return the topmost discriminant. + function Search_Derivation_Levels (Ti : Entity_Id; Discrim_Values : Elist_Id; @@ -15608,6 +15613,23 @@ package body Sem_Ch3 is -- This is the routine that performs the recursive search of levels -- as described above. + ------------------------------------- + -- Root_Corresponding_Discriminant -- + ------------------------------------- + + function Root_Corresponding_Discriminant + (Discr : Entity_Id) return Entity_Id + is + D : Entity_Id := Discr; + + begin + while Present (Corresponding_Discriminant (D)) loop + D := Corresponding_Discriminant (D); + end loop; + + return D; + end Root_Corresponding_Discriminant; + ------------------------------ -- Search_Derivation_Levels -- ------------------------------ @@ -15782,7 +15804,7 @@ package body Sem_Ch3 is -- ??? hack to disappear when this routine is gone - if Nkind (Result) = N_Defining_Identifier then + if Nkind (Result) = N_Defining_Identifier then declare D : Entity_Id; E : Elmt_Id; @@ -15791,7 +15813,7 @@ package body Sem_Ch3 is D := First_Discriminant (Typ_For_Constraint); E := First_Elmt (Constraint); while Present (D) loop - if Corresponding_Discriminant (D) = Discriminant then + if Root_Corresponding_Discriminant (D) = Discriminant then return Node (E); end if; -- 2.30.2