From 5b85ad7d19aa1428b4f657bbbd5bf39d34ecbb14 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Fri, 15 Dec 2017 14:09:02 +0000 Subject: [PATCH] exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use Component_Size of the innermost array instead of Esize of its component... gcc/ada/ 2017-12-15 Eric Botcazou * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use Component_Size of the innermost array instead of Esize of its component type to exclude inappropriate array types, including packed array types. 2017-12-15 Hristian Kirtchev * sem_prag.adb (Analyze_Input_Item): Allow concurrent types to appear within the input list of Initializes. Remove the uses of Input_OK. 2017-12-15 Ed Schonberg * exp_ch4.adb (Expand_N_In): Do not replace a membership test on a scalar type with a validity test when the membership appears in a predicate expression, to prevent a spurious error when predicate is specified static. * sem_ch13.adb (Build_Predicate_Functions): Add warning if a static predicate, after constant-folding, reduces to True and is this redundant. * par-ch4.adb: Typo fixes and minor reformattings. 2017-12-15 Hristian Kirtchev * sem_elab.adb (Ensure_Prior_Elaboration_Static): Mark the generated with clause as being implicit for an instantiation in order to circumvent an issue with 'W' and 'Z' line encodings in ALI files. 2017-12-15 Ed Schonberg * sem_util.adb (Is_Potentially_Unevaluated): Detect further cases of misuse of 'Old that appear within an expression that is potentially unevaluated, when the prefix of the attribute does not statically designate an object (e.g. a function call). 2017-12-15 Ed Schonberg * sem_ch6.adb (Conformking_Types): Two incomplete types are conforming when one of them is used as a generic actual, but only within an instantiation. * einfo.ads: Clarify use of flag Used_As_Generic_Actual. 2017-12-15 Justin Squirek * sem_attr.adb (Resolve_Attribute): Modify check for aliased view on prefix to use the prefix's original node to avoid looking at expanded conversions for certain array types. 2017-12-15 Ed Schonberg * sem_res.adb (Resolve_Membership_Op): Add warning on a membership operation on a scalar type for which there is a user-defined equality operator. 2017-12-15 Yannick Moy * doc/gnat_rm/implementation_defined_pragmas.rst: Add Ghost assertion policy. gcc/testsuite/ 2017-12-15 Justin Squirek * gnat.dg/aliasing4.adb: New testcase. 2017-12-15 Ed Schonberg * gnat.dg/incomplete6.adb, gnat.dg/incomplete6.ads: New testcase. 2017-12-15 Hristian Kirtchev * gnat.dg/initializes.ads, gnat.dg/initializes.adb: New testcase. 2017-12-15 Eric Botcazou * gnat.dg/component_size.adb: New testcase. From-SVN: r255695 --- gcc/ada/ChangeLog | 59 +++++++++++++++++++ .../implementation_defined_pragmas.rst | 1 + gcc/ada/einfo.ads | 4 +- gcc/ada/exp_aggr.adb | 52 +++++++++------- gcc/ada/exp_ch4.adb | 16 ++++- gcc/ada/gnat_rm.texi | 3 +- gcc/ada/par-ch4.adb | 8 +-- gcc/ada/sem_attr.adb | 2 +- gcc/ada/sem_ch13.adb | 6 ++ gcc/ada/sem_ch4.adb | 4 +- gcc/ada/sem_ch6.adb | 4 +- gcc/ada/sem_elab.adb | 10 ++++ gcc/ada/sem_prag.adb | 32 +++++----- gcc/ada/sem_res.adb | 15 +++++ gcc/ada/sem_util.adb | 23 ++++++-- gcc/testsuite/ChangeLog | 16 +++++ gcc/testsuite/gnat.dg/component_size.adb | 37 ++++++++++++ gcc/testsuite/gnat.dg/incomplete6.adb | 15 +++++ gcc/testsuite/gnat.dg/incomplete6.ads | 22 +++++++ gcc/testsuite/gnat.dg/initializes.adb | 33 +++++++++++ gcc/testsuite/gnat.dg/initializes.ads | 13 ++++ 21 files changed, 319 insertions(+), 56 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/component_size.adb create mode 100644 gcc/testsuite/gnat.dg/incomplete6.adb create mode 100644 gcc/testsuite/gnat.dg/incomplete6.ads create mode 100644 gcc/testsuite/gnat.dg/initializes.adb create mode 100644 gcc/testsuite/gnat.dg/initializes.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 528a5e67f33..fb3e7f48218 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,62 @@ +2017-12-15 Eric Botcazou + + * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use Component_Size of + the innermost array instead of Esize of its component type to exclude + inappropriate array types, including packed array types. + +2017-12-15 Hristian Kirtchev + + * sem_prag.adb (Analyze_Input_Item): Allow concurrent types to appear + within the input list of Initializes. Remove the uses of Input_OK. + +2017-12-15 Ed Schonberg + + * exp_ch4.adb (Expand_N_In): Do not replace a membership test on a + scalar type with a validity test when the membership appears in a + predicate expression, to prevent a spurious error when predicate is + specified static. + * sem_ch13.adb (Build_Predicate_Functions): Add warning if a static + predicate, after constant-folding, reduces to True and is this + redundant. + * par-ch4.adb: Typo fixes and minor reformattings. + +2017-12-15 Hristian Kirtchev + + * sem_elab.adb (Ensure_Prior_Elaboration_Static): Mark the generated + with clause as being implicit for an instantiation in order to + circumvent an issue with 'W' and 'Z' line encodings in ALI files. + +2017-12-15 Ed Schonberg + + * sem_util.adb (Is_Potentially_Unevaluated): Detect further cases of + misuse of 'Old that appear within an expression that is potentially + unevaluated, when the prefix of the attribute does not statically + designate an object (e.g. a function call). + +2017-12-15 Ed Schonberg + + * sem_ch6.adb (Conformking_Types): Two incomplete types are conforming + when one of them is used as a generic actual, but only within an + instantiation. + * einfo.ads: Clarify use of flag Used_As_Generic_Actual. + +2017-12-15 Justin Squirek + + * sem_attr.adb (Resolve_Attribute): Modify check for aliased view on + prefix to use the prefix's original node to avoid looking at expanded + conversions for certain array types. + +2017-12-15 Ed Schonberg + + * sem_res.adb (Resolve_Membership_Op): Add warning on a membership + operation on a scalar type for which there is a user-defined equality + operator. + +2017-12-15 Yannick Moy + + * doc/gnat_rm/implementation_defined_pragmas.rst: Add Ghost assertion + policy. + 2017-12-15 Hristian Kirtchev * sem_prag.adb (Analyze_Initialization_Item): Remove the specialized diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 1281758ac16..d6ded29fa40 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -419,6 +419,7 @@ Syntax:: Assume | Contract_Cases | Debug | + Ghost | Invariant | Invariant'Class | Loop_Invariant | diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index bb5b5e983f7..dd6652b0566 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4583,7 +4583,9 @@ package Einfo is -- Used_As_Generic_Actual (Flag222) -- Defined in all entities, set if the entity is used as an argument to --- a generic instantiation. Used to tune certain warning messages. +-- a generic instantiation. Used to tune certain warning messages, and +-- in checking type conformance within an instantiation that involves +-- incomplete formal and actual types. -- Uses_Lock_Free (Flag188) -- Defined in protected type entities. Set to True when the Lock Free diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 8aca0d2602a..92c040ee8ab 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4895,14 +4895,14 @@ package body Exp_Aggr is -- 1. N consists of a single OTHERS choice, possibly recursively - -- 2. The array type is not packed + -- 2. The array type has no null ranges (the purpose of this is to + -- avoid a bogus warning for an out-of-range value). -- 3. The array type has no atomic components - -- 4. The array type has no null ranges (the purpose of this is to - -- avoid a bogus warning for an out-of-range value). + -- 4. The component type is elementary - -- 5. The component type is elementary + -- 5. The component size is a multiple of Storage_Unit -- 6. The component size is Storage_Unit or the value is of the form -- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit) @@ -4918,6 +4918,7 @@ package body Exp_Aggr is Expr : Node_Id := N; Low : Node_Id; High : Node_Id; + Csiz : Uint; Remainder : Uint; Value : Uint; Nunits : Nat; @@ -4933,14 +4934,6 @@ package body Exp_Aggr is return False; end if; - if Present (Packed_Array_Impl_Type (Ctyp)) then - return False; - end if; - - if Has_Atomic_Components (Ctyp) then - return False; - end if; - Index := First_Index (Ctyp); while Present (Index) loop Get_Index_Bounds (Index, Low, High); @@ -4964,6 +4957,11 @@ package body Exp_Aggr is Expr := Expression (First (Component_Associations (Expr))); end loop; + if Has_Atomic_Components (Ctyp) then + return False; + end if; + + Csiz := Component_Size (Ctyp); Ctyp := Component_Type (Ctyp); if Is_Atomic_Or_VFA (Ctyp) then @@ -4978,20 +4976,19 @@ package body Exp_Aggr is return False; end if; - -- All elementary types are supported + -- Access types need to be dealt with specially - if not Is_Elementary_Type (Ctyp) then - return False; - end if; + if Is_Access_Type (Ctyp) then - -- However access types need to be dealt with specially + -- Component_Size is not set by Layout_Type if the component + -- type is an access type ??? - if Is_Access_Type (Ctyp) then + Csiz := Esize (Ctyp); -- Fat pointers are rejected as they are not really elementary -- for the backend. - if Esize (Ctyp) /= System_Address_Size then + if Csiz /= System_Address_Size then return False; end if; @@ -5002,15 +4999,26 @@ package body Exp_Aggr is if Nkind (Expr) /= N_Null and then not Is_Entity_Name (Expr) then return False; end if; + + -- Scalar types are OK if their size is a multiple of Storage_Unit + + elsif Is_Scalar_Type (Ctyp) then + + if Csiz mod System_Storage_Unit /= 0 then + return False; + end if; + + -- Composite types are rejected + + else + return False; end if; -- The expression needs to be analyzed if True is returned Analyze_And_Resolve (Expr, Ctyp); - -- The back end uses the Esize as the precision of the type - - Nunits := UI_To_Int (Esize (Ctyp)) / System_Storage_Unit; + Nunits := UI_To_Int (Csiz) / System_Storage_Unit; if Nunits = 1 then return True; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c3aa2d2681f..c5f64ae9252 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6015,10 +6015,20 @@ package body Exp_Ch4 is -- have a test in the generic that makes sense with some types -- and not with other types. - and then not In_Instance + -- Similarly, do not rewrite membership as a validity check if + -- within the predicate function for the type. + then - Substitute_Valid_Check; - goto Leave; + if In_Instance + or else (Ekind (Current_Scope) = E_Function + and then Is_Predicate_Function (Current_Scope)) + then + null; + + else + Substitute_Valid_Check; + goto Leave; + end if; end if; -- If we have an explicit range, do a bit of optimization based on diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 0a2b151dffa..0cec92a8880 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Nov 09, 2017 +GNAT Reference Manual , Dec 15, 2017 AdaCore @@ -1784,6 +1784,7 @@ ID_ASSERTION_KIND ::= Assertions | Assume | Contract_Cases | Debug | + Ghost | Invariant | Invariant'Class | Loop_Invariant | diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 4b5ef456ed9..893011a81fc 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -645,8 +645,8 @@ package body Ch4 is -- case of a name which can be extended in the normal manner. -- This case is handled by LP_State_Name or LP_State_Expr. - -- (Ada2020) : the expression can be a reduction_expression_ - -- psarameter, i.e. a box or < Simple_Expression > + -- (Ada 2020): the expression can be a reduction_expression_ + -- parameter, i.e. a box or < Simple_Expression >. -- Note: if and case expressions (without an extra level of -- parentheses) are permitted in this context). @@ -679,7 +679,7 @@ package body Ch4 is end if; -- Here we have an expression after all, which may be a reduction - -- expression with a binary operator + -- expression with a binary operator. if Token = Tok_Less then Scan; -- past < @@ -2894,7 +2894,7 @@ package body Ch4 is Node1 := P_Name; return Node1; - -- Ada2020: reduction expression parameter + -- Ada 2020: reduction expression parameter when Tok_Less => Scan; -- past < diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 91aa5792bf5..6db531a7f2b 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -11111,7 +11111,7 @@ package body Sem_Attr is and then not (Nkind (P) = N_Selected_Component and then Is_Overloadable (Entity (Selector_Name (P)))) - and then not Is_Aliased_View (P) + and then not Is_Aliased_View (Original_Node (P)) and then not In_Instance and then not In_Inlined_Body and then Comes_From_Source (N) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ebf1328e4ce..d2533b01f7e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11919,6 +11919,12 @@ package body Sem_Ch13 is then return True; + elsif Is_Entity_Name (Expr) + and then Entity (Expr) = Standard_True + then + Error_Msg_N ("predicate is redundant (always True)?", Expr); + return True; + -- That's an exhaustive list of tests, all other cases are not -- predicate-static, so we return False. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4791bf8c227..0a6c30ad8b9 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4155,7 +4155,7 @@ package body Sem_Ch4 is and then Parent (Loop_Par) /= N then -- The parser cannot distinguish between a loop specification - -- and an iterator specification. If after pre-analysis the + -- and an iterator specification. If after preanalysis the -- proper form has been recognized, rewrite the expression to -- reflect the right kind. This is needed for proper ASIS -- navigation. If expansion is enabled, the transformation is @@ -4378,7 +4378,7 @@ package body Sem_Ch4 is and then Parent (Loop_Par) /= N then -- The parser cannot distinguish between a loop specification - -- and an iterator specification. If after pre-analysis the + -- and an iterator specification. If after preanalysis the -- proper form has been recognized, rewrite the expression to -- reflect the right kind. This is needed for proper ASIS -- navigation. If expansion is enabled, the transformation is diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1139a56136e..cb5b3e7bd9a 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7666,10 +7666,12 @@ package body Sem_Ch6 is return True; -- In Ada 2012, incomplete types (including limited views) can appear - -- as actuals in instantiations. + -- as actuals in instantiations, where they are conformant to the + -- corresponding incomplete formal. elsif Is_Incomplete_Type (Type_1) and then Is_Incomplete_Type (Type_2) + and then In_Instance and then (Used_As_Generic_Actual (Type_1) or else Used_As_Generic_Actual (Type_2)) then diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 152def24b0d..90746b4862e 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -3585,6 +3585,16 @@ package body Sem_Elab is Set_Implicit_With (Clause); Set_Library_Unit (Clause, Unit_Cunit); + -- The following is a kludge to satisfy a GPRbuild requirement. In + -- general, internal with clauses should be encoded on a 'Z' line in + -- ALI files, but due to an old bug, they are encoded as source with + -- clauses on a 'W' line. As a result, these "semi-implicit" clauses + -- introduce spurious build dependencies in GPRbuild. The only way to + -- eliminate this effect is to mark the implicit clauses as generated + -- for an instantiation. + + Set_Implicit_With_From_Instantiation (Clause); + Append_To (Items, Clause); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d98d9cf04b4..6bf66ad84a8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2867,7 +2867,6 @@ package body Sem_Prag is procedure Analyze_Input_Item (Input : Node_Id) is Input_Id : Entity_Id; - Input_OK : Boolean := True; begin -- Null input list @@ -2908,6 +2907,8 @@ package body Sem_Prag is E_In_Parameter, E_In_Out_Parameter, E_Out_Parameter, + E_Protected_Type, + E_Task_Type, E_Variable) then -- The input cannot denote states or objects declared @@ -2933,11 +2934,11 @@ package body Sem_Prag is null; else - Input_OK := False; Error_Msg_Name_1 := Chars (Pack_Id); SPARK_Msg_NE ("input item & cannot denote a visible object or " & "state of package %", Input, Input_Id); + return; end if; end if; @@ -2945,26 +2946,25 @@ package body Sem_Prag is -- (SPARK RM 7.1.5(5)). if Contains (Inputs_Seen, Input_Id) then - Input_OK := False; SPARK_Msg_N ("duplicate input item", Input); + return; end if; - -- Input is legal, add it to the list of processed inputs + -- At this point it is known that the input is legal. Add + -- it to the list of processed inputs. - if Input_OK then - Append_New_Elmt (Input_Id, Inputs_Seen); + Append_New_Elmt (Input_Id, Inputs_Seen); - if Ekind (Input_Id) = E_Abstract_State then - Append_New_Elmt (Input_Id, States_Seen); - end if; + if Ekind (Input_Id) = E_Abstract_State then + Append_New_Elmt (Input_Id, States_Seen); + end if; - if Ekind_In (Input_Id, E_Abstract_State, - E_Constant, - E_Variable) - and then Present (Encapsulating_State (Input_Id)) - then - Append_New_Elmt (Input_Id, Constits_Seen); - end if; + if Ekind_In (Input_Id, E_Abstract_State, + E_Constant, + E_Variable) + and then Present (Encapsulating_State (Input_Id)) + then + Append_New_Elmt (Input_Id, Constits_Seen); end if; -- The input references something that is not a state or an diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 969b8bdb070..23a95a46c8e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9086,6 +9086,21 @@ package body Sem_Res is end loop; end; end if; + + -- RM 4.5.2 (28.1/3) specifies that for types other than records or + -- limited types, evaluation of a membership test uses the predefined + -- equality for the type. This may be confusing to users, and the + -- following warning appears useful for the most common case. + + if Is_Scalar_Type (Ltyp) + and then Present (Get_User_Defined_Eq (Ltyp)) + then + Error_Msg_NE + ("membership test on& uses predefined equality?", N, Ltyp); + Error_Msg_N + ("\even if user-defined equality exists (RM 4.5.2 (28.1/3)?", N); + end if; + end Resolve_Set_Membership; -- Start of processing for Resolve_Membership_Op diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 248a9b7cff6..972bda5e346 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15816,17 +15816,30 @@ package body Sem_Util is begin Expr := N; - Par := Parent (N); + Par := N; -- A postcondition whose expression is a short-circuit is broken down -- into individual aspects for better exception reporting. The original -- short-circuit expression is rewritten as the second operand, and an -- occurrence of 'Old in that operand is potentially unevaluated. - -- See Sem_ch13.adb for details of this transformation. + -- See sem_ch13.adb for details of this transformation. The reference + -- to 'Old may appear within an expression, so we must look for the + -- enclosing pragma argument in the tree that contains the reference. - if Nkind (Original_Node (Par)) = N_And_Then then - return True; - end if; + while Present (Par) + and then Nkind (Par) /= N_Pragma_Argument_Association + loop + if Nkind (Original_Node (Par)) = N_And_Then then + return True; + end if; + + Par := Parent (Par); + end loop; + + -- Other cases; 'Old appears within other expression (not the top-level + -- conjunct in a postcondition) with a potentially unevaluated operand. + + Par := Parent (Expr); while not Nkind_In (Par, N_If_Expression, N_Case_Expression, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1477cabcacb..176a7b9c44f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,19 @@ +2017-12-15 Justin Squirek + + * gnat.dg/aliasing4.adb: New testcase. + +2017-12-15 Ed Schonberg + + * gnat.dg/incomplete6.adb, gnat.dg/incomplete6.ads: New testcase. + +2017-12-15 Hristian Kirtchev + + * gnat.dg/initializes.ads, gnat.dg/initializes.adb: New testcase. + +2017-12-15 Eric Botcazou + + * gnat.dg/component_size.adb: New testcase. + 2017-12-15 Richard Biener PR lto/83388 diff --git a/gcc/testsuite/gnat.dg/component_size.adb b/gcc/testsuite/gnat.dg/component_size.adb new file mode 100644 index 00000000000..72b170de6a7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/component_size.adb @@ -0,0 +1,37 @@ +-- { dg-do run } + +procedure Component_Size is + + C_Unsigned_Long_Size : constant := 32; + type T_Unsigned_Long is range 0 .. (2 ** 31) - 1; + for T_Unsigned_Long'Size use C_Unsigned_Long_Size; + + C_Unsigned_Byte_Size : constant := 8; + type T_Unsigned_Byte is range 0 .. (2 ** 8) - 1; + for T_Unsigned_Byte'Size use C_Unsigned_Byte_Size; + + type T_Unsigned_Byte_Without_Size_Repr is range 0 .. (2 ** 8) - 1; + + C_Nb_Data : constant T_Unsigned_Long := 9; + subtype T_Nb_Data is T_Unsigned_Long range 1 .. C_Nb_Data; + + type T_Wrong_Id is array (T_Nb_Data) of T_Unsigned_Byte; + for T_Wrong_Id'Component_Size use C_Unsigned_Long_Size; + + type T_Correct_Id is array (T_Nb_Data) of T_Unsigned_Byte_Without_Size_Repr; + for T_Correct_Id'Component_Size use C_Unsigned_Long_Size; + + C_Value : constant := 1; + + C_Wrong_Id : constant T_Wrong_Id := T_Wrong_Id'(others => C_Value); + C_Correct_Id : constant T_Correct_Id := T_Correct_Id'(others => C_Value); + +begin + if C_Correct_Id /= T_Correct_Id'(others => C_Value) then + raise Program_Error; + end if; + + if C_Wrong_Id /= T_Wrong_Id'(others => C_Value) then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/incomplete6.adb b/gcc/testsuite/gnat.dg/incomplete6.adb new file mode 100644 index 00000000000..b2bf64297e1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/incomplete6.adb @@ -0,0 +1,15 @@ +-- { dg-do compile } + +package body Incomplete6 is + + function "=" (Left, Right : Vint) return Boolean is + begin + return Left.Value = Right.Value; + end; + + function "=" (Left, Right : Vfloat) return Boolean is + begin + return Left.Value = Right.Value; + end; + +end; diff --git a/gcc/testsuite/gnat.dg/incomplete6.ads b/gcc/testsuite/gnat.dg/incomplete6.ads new file mode 100644 index 00000000000..52beb6e5f5b --- /dev/null +++ b/gcc/testsuite/gnat.dg/incomplete6.ads @@ -0,0 +1,22 @@ +with Ada.Unchecked_Conversion; + +package Incomplete6 is + + type Vint; + function "=" (Left, Right : Vint) return Boolean; + + type Vint is record + Value : Integer; + end record; + + function To_Integer is new + Ada.Unchecked_Conversion(Source => Vint, Target => Integer); + + type Vfloat; + function "=" (Left, Right : in Vfloat) return Boolean; + + type Vfloat is record + Value : Float; + end record; + +end; diff --git a/gcc/testsuite/gnat.dg/initializes.adb b/gcc/testsuite/gnat.dg/initializes.adb new file mode 100644 index 00000000000..11058ed2b30 --- /dev/null +++ b/gcc/testsuite/gnat.dg/initializes.adb @@ -0,0 +1,33 @@ +-- { dg-do compile } + +package body Initializes is + protected body PO is + procedure Proc is + package Inner with Initializes => (Y => PO) is -- OK + Y : Boolean := X; + end Inner; + + procedure Nested with Global => PO is -- OK + begin + null; + end Nested; + begin + Nested; + end Proc; + end PO; + + protected body PT is + procedure Proc is + package Inner with Initializes => (Y => PT) is -- OK + Y : Boolean := X; + end Inner; + + procedure Nested with Global => PT is -- OK + begin + null; + end Nested; + begin + Nested; + end Proc; + end PT; +end Initializes; diff --git a/gcc/testsuite/gnat.dg/initializes.ads b/gcc/testsuite/gnat.dg/initializes.ads new file mode 100644 index 00000000000..d7b2f93342f --- /dev/null +++ b/gcc/testsuite/gnat.dg/initializes.ads @@ -0,0 +1,13 @@ +package Initializes is + protected PO is + procedure Proc; + private + X : Boolean := True; + end PO; + + protected type PT is + procedure Proc; + private + X : Boolean := True; + end PT; +end Initializes; -- 2.30.2