From: Ed Schonberg Date: Fri, 25 Jun 2021 13:54:17 +0000 (-0700) Subject: [Ada] Spurious link error with child unit and different Assertion modes. X-Git-Tag: basepoints/gcc-13~4613 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=325443d24bb480a2c75d36496f1ccc3fe2943968;p=thirdparty%2Fgcc.git [Ada] Spurious link error with child unit and different Assertion modes. gcc/ada/ * exp_util.ads (Force_Evaluation): Add formal parameter Discr_Number, to indicate discriminant expression for which an external name must be created. (Remove_Side_Effects): Ditto. * exp_util.adb (Force_Evaluation): Call Remove_Side_Effects with added parameter. (Remove_Side_Effects, Build_Temporary): If Discr_Number is positive, create an external name with suffix DISCR and the given discriminant number, analogous to what is done for temporaries for array type bounds. * sem_ch3.adb (Process_Discriminant_Expressions): If the constraint is for an object or component declaration and the corresponding entity may be visible in another unit, invoke Force_Evaluation with the new parameter. --- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 258404132315..4b7615aab87e 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6589,6 +6589,7 @@ package body Exp_Util is Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; Is_High_Bound : Boolean := False; + Discr_Number : Int := 0; Mode : Force_Evaluation_Mode := Relaxed) is begin @@ -6600,6 +6601,7 @@ package body Exp_Util is Related_Id => Related_Id, Is_Low_Bound => Is_Low_Bound, Is_High_Bound => Is_High_Bound, + Discr_Number => Discr_Number, Check_Side_Effects => Is_Static_Expression (Exp) or else Mode = Relaxed); @@ -11623,6 +11625,7 @@ package body Exp_Util is Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; Is_High_Bound : Boolean := False; + Discr_Number : Int := 0; Check_Side_Effects : Boolean := True) is function Build_Temporary @@ -11653,13 +11656,28 @@ package body Exp_Util is Temp_Nam : Name_Id; begin - -- The context requires an external symbol + -- The context requires an external symbol : expression is + -- the bound of an array, or a discriminant value. We create + -- a unique string using the related entity and an appropriate + -- suffix, rather than a numeric serial number (used for internal + -- entities) that may vary depending on compilation options, in + -- particular on the Assertions_Enabled mode. This avoids spurious + -- link errors. if Present (Related_Id) then if Is_Low_Bound then Temp_Nam := New_External_Name (Chars (Related_Id), "_FIRST"); - else pragma Assert (Is_High_Bound); + + elsif Is_High_Bound then Temp_Nam := New_External_Name (Chars (Related_Id), "_LAST"); + + else + pragma Assert (Discr_Number > 0); + -- Use fully qualified name to avoid ambiguities. + + Temp_Nam := + New_External_Name + (Get_Qualified_Name (Related_Id), "_DISCR", Discr_Number); end if; Temp_Id := Make_Defining_Identifier (Loc, Temp_Nam); diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 5c931c946a94..56ff61f489b6 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -668,6 +668,7 @@ package Exp_Util is Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; Is_High_Bound : Boolean := False; + Discr_Number : Int := 0; Mode : Force_Evaluation_Mode := Relaxed); -- Force the evaluation of the expression right away. Similar behavior -- to Remove_Side_Effects when Variable_Ref is set to TRUE. That is to @@ -688,6 +689,12 @@ package Exp_Util is -- of the Is_xxx_Bound flags must be set. For use of these parameters see -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. + -- Discr_Number is positive when the expression is a discriminant value + -- in an object or component declaration. In that case Discr_Number is + -- the position of the corresponding discriminant in the corresponding + -- type declaration, and the name for the evaluated expression is built + -- out of the Related_Id and the Discr_Number. + function Fully_Qualified_Name_String (E : Entity_Id; Append_NUL : Boolean := True) return String_Id; @@ -1004,6 +1011,7 @@ package Exp_Util is Related_Id : Entity_Id := Empty; Is_Low_Bound : Boolean := False; Is_High_Bound : Boolean := False; + Discr_Number : Int := 0; Check_Side_Effects : Boolean := True); -- Given the node for a subexpression, this function replaces the node if -- necessary by an equivalent subexpression that is guaranteed to be side @@ -1028,6 +1036,9 @@ package Exp_Util is -- of the Is_xxx_Bound flags must be set. For use of these parameters see -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. -- + -- If Discr_Number is positive, the expression denotes a discrimant value + -- in a constraint, the suffix DISCR is used to create the external name. + -- The side effects are captured using one of the following methods: -- -- 1) a constant initialized with the value of the subexpression diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c0983f5c2589..7ab72aff06df 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10492,7 +10492,26 @@ package body Sem_Ch3 is Apply_Range_Check (Discr_Expr (J), Etype (Discr)); end if; - Force_Evaluation (Discr_Expr (J)); + -- If the value of the discriminant may be visible in + -- another unit or child unit, create an external name + -- for it. We use the name of the object or component + -- that carries the discriminated subtype. The code + -- below may generate external symbols for the discriminant + -- expression when not strictly needed, which is harmless. + + if Expander_Active + and then Comes_From_Source (Def) + and then not Is_Subprogram (Current_Scope) + and then Nkind (Parent (Def)) in + N_Object_Declaration | N_Component_Declaration + then + Force_Evaluation ( + Discr_Expr (J), + Related_Id => Defining_Identifier (Parent (Def)), + Discr_Number => J); + else + Force_Evaluation (Discr_Expr (J)); + end if; end if; -- Check that the designated type of an access discriminant's