diff options
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/namet.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/namet.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/sem_ch2.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 36 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/out_param.adb | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/unreferenced.adb | 11 |
13 files changed, 165 insertions, 101 deletions
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 3d8f3e7..3385efa 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8717,10 +8717,11 @@ package body Exp_Ch3 is -- Initialize secondary tags else - Initialize_Tag (Full_Typ, - Iface => Node (Iface_Elmt), - Tag_Comp => Tag_Comp, - Iface_Tag => Node (Iface_Tag_Elmt)); + Initialize_Tag + (Typ => Full_Typ, + Iface => Node (Iface_Elmt), + Tag_Comp => Tag_Comp, + Iface_Tag => Node (Iface_Tag_Elmt)); end if; -- Otherwise generate code to initialize the tag @@ -8729,10 +8730,11 @@ package body Exp_Ch3 is if (In_Variable_Pos and then Variable_Comps) or else (not In_Variable_Pos and then Fixed_Comps) then - Initialize_Tag (Full_Typ, - Iface => Node (Iface_Elmt), - Tag_Comp => Tag_Comp, - Iface_Tag => Node (Iface_Tag_Elmt)); + Initialize_Tag + (Typ => Full_Typ, + Iface => Node (Iface_Elmt), + Tag_Comp => Tag_Comp, + Iface_Tag => Node (Iface_Tag_Elmt)); end if; end if; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index fb94d86..7138c85 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -384,9 +384,10 @@ procedure Gnat1drv is Relaxed_RM_Semantics := True; if not Generate_CodePeer_Messages then + -- Suppress compiler warnings by default when generating SCIL for - -- CodePeer, except when combined with -gnateC where we do want - -- to emit GNAT warnings. + -- CodePeer, except when combined with -gnateC where we do want to + -- emit GNAT warnings. Warning_Mode := Suppress; end if; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index ddb5482..13e8e1f 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -175,7 +175,8 @@ package body Namet is -------------------- procedure Append_Decoded - (Buf : in out Bounded_String; Id : Valid_Name_Id) + (Buf : in out Bounded_String; + Id : Valid_Name_Id) is C : Character; P : Natural; @@ -599,7 +600,8 @@ package body Namet is ------------------------ procedure Append_Unqualified - (Buf : in out Bounded_String; Id : Valid_Name_Id) + (Buf : in out Bounded_String; + Id : Valid_Name_Id) is Temp : Bounded_String; begin @@ -1476,7 +1478,10 @@ package body Namet is -- Name_Equals -- ----------------- - function Name_Equals (N1, N2 : Valid_Name_Id) return Boolean is + function Name_Equals + (N1 : Valid_Name_Id; + N2 : Valid_Name_Id) return Boolean + is begin return N1 = N2 or else Get_Name_String (N1) = Get_Name_String (N2); end Name_Equals; diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index f5b078d..b55d336 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -358,7 +358,9 @@ package Namet is -- names, since these are efficiently located without hashing by Name_Find -- in any case. - function Name_Equals (N1, N2 : Valid_Name_Id) return Boolean; + function Name_Equals + (N1 : Valid_Name_Id; + N2 : Valid_Name_Id) return Boolean; -- Return whether N1 and N2 denote the same character sequence function Get_Name_String (Id : Valid_Name_Id) return String; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 62b5934..e49a70b 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2765,7 +2765,7 @@ package body Sem_Aggr is ----------------------------- procedure Resolve_Delta_Aggregate (N : Node_Id; Typ : Entity_Id) is - Base : constant Node_Id := Expression (N); + Base : constant Node_Id := Expression (N); begin if not Is_Composite_Type (Typ) then @@ -2789,12 +2789,14 @@ package body Sem_Aggr is procedure Resolve_Delta_Array_Aggregate (N : Node_Id; Typ : Entity_Id) is Deltas : constant List_Id := Component_Associations (N); + Assoc : Node_Id; Choice : Node_Id; Index_Type : Entity_Id; begin Index_Type := Etype (First_Index (Typ)); + Assoc := First (Deltas); while Present (Assoc) loop if Nkind (Assoc) = N_Iterated_Component_Association then @@ -2843,10 +2845,12 @@ package body Sem_Aggr is else Analyze (Choice); + if Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)) then - -- Choice covers a range of values. + -- Choice covers a range of values + if Base_Type (Entity (Choice)) /= Base_Type (Index_Type) then @@ -2874,28 +2878,17 @@ package body Sem_Aggr is ------------------------------------ procedure Resolve_Delta_Record_Aggregate (N : Node_Id; Typ : Entity_Id) is - Deltas : constant List_Id := Component_Associations (N); - Assoc : Node_Id; - Choice : Node_Id; - Comp_Type : Entity_Id; - - -- Variables used to verify that discriminant-dependent components - -- appear in the same variant. - - Variant : Node_Id; - Comp_Ref : Entity_Id; - procedure Check_Variant (Id : Entity_Id); -- If a given component of the delta aggregate appears in a variant -- part, verify that it is within the same variant as that of previous -- specified variant components of the delta. - function Nested_In (V1, V2 : Node_Id) return Boolean; - -- Determine whether variant V1 is within variant V2. - function Get_Component_Type (Nam : Node_Id) return Entity_Id; - -- Locate component with a given name and return its type. If none - -- found report error. + -- Locate component with a given name and return its type. If none found + -- report error. + + function Nested_In (V1 : Node_Id; V2 : Node_Id) return Boolean; + -- Determine whether variant V1 is within variant V2 function Variant_Depth (N : Node_Id) return Integer; -- Determine the distance of a variant to the enclosing type @@ -2907,13 +2900,17 @@ package body Sem_Aggr is procedure Check_Variant (Id : Entity_Id) is Comp : Entity_Id; + Comp_Ref : Entity_Id; Comp_Variant : Node_Id; + Variant : Node_Id; begin if not Has_Discriminants (Typ) then return; end if; + Variant := Empty; + Comp := First_Entity (Typ); while Present (Comp) loop exit when Chars (Comp) = Chars (Id); @@ -2937,9 +2934,9 @@ package body Sem_Aggr is begin if D1 = D2 or else - (D1 > D2 and then not Nested_In (Variant, Comp_Variant)) + (D1 > D2 and then not Nested_In (Variant, Comp_Variant)) or else - (D2 > D1 and then not Nested_In (Comp_Variant, Variant)) + (D2 > D1 and then not Nested_In (Comp_Variant, Variant)) then Error_Msg_Node_2 := Comp_Ref; Error_Msg_NE @@ -2955,18 +2952,45 @@ package body Sem_Aggr is end if; end Check_Variant; + ------------------------ + -- Get_Component_Type -- + ------------------------ + + function Get_Component_Type (Nam : Node_Id) return Entity_Id is + Comp : Entity_Id; + + begin + Comp := First_Entity (Typ); + while Present (Comp) loop + if Chars (Comp) = Chars (Nam) then + if Ekind (Comp) = E_Discriminant then + Error_Msg_N ("delta cannot apply to discriminant", Nam); + end if; + + return Etype (Comp); + end if; + + Comp := Next_Entity (Comp); + end loop; + + Error_Msg_NE ("type& has no component with this name", Nam, Typ); + return Any_Type; + end Get_Component_Type; + --------------- -- Nested_In -- --------------- function Nested_In (V1, V2 : Node_Id) return Boolean is Par : Node_Id; + begin Par := Parent (V1); while Nkind (Par) /= N_Full_Type_Declaration loop if Par = V2 then return True; end if; + Par := Parent (Par); end loop; @@ -2980,53 +3004,35 @@ package body Sem_Aggr is function Variant_Depth (N : Node_Id) return Integer is Depth : Integer; Par : Node_Id; + begin Depth := 0; Par := Parent (N); while Nkind (Par) /= N_Full_Type_Declaration loop Depth := Depth + 1; - Par := Parent (Par); + Par := Parent (Par); end loop; return Depth; end Variant_Depth; - ------------------------ - -- Get_Component_Type -- - ------------------------ - - function Get_Component_Type (Nam : Node_Id) return Entity_Id is - Comp : Entity_Id; - - begin - Comp := First_Entity (Typ); - - while Present (Comp) loop - if Chars (Comp) = Chars (Nam) then - if Ekind (Comp) = E_Discriminant then - Error_Msg_N ("delta cannot apply to discriminant", Nam); - end if; - - return Etype (Comp); - end if; + -- Local variables - Comp := Next_Entity (Comp); - end loop; + Deltas : constant List_Id := Component_Associations (N); - Error_Msg_NE ("type& has no component with this name", Nam, Typ); - return Any_Type; - end Get_Component_Type; + Assoc : Node_Id; + Choice : Node_Id; + Comp_Type : Entity_Id; -- Start of processing for Resolve_Delta_Record_Aggregate begin - Variant := Empty; Assoc := First (Deltas); - while Present (Assoc) loop Choice := First (Choice_List (Assoc)); while Present (Choice) loop Comp_Type := Get_Component_Type (Choice); + if Comp_Type /= Any_Type then Check_Variant (Choice); end if; diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index 92f1c02..904a8f0 100644 --- a/gcc/ada/sem_ch2.adb +++ b/gcc/ada/sem_ch2.adb @@ -68,9 +68,7 @@ package body Sem_Ch2 is -- this is the result of some kind of previous error generating a -- junk identifier. - if not Is_Valid_Name (Chars (N)) - and then Total_Errors_Detected /= 0 - then + if not Is_Valid_Name (Chars (N)) and then Total_Errors_Detected /= 0 then return; else Find_Direct_Name (N); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 3102678..4532ac4 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -412,12 +412,12 @@ package body Sem_Ch4 is -- Analyze_Aggregate -- ----------------------- - -- Most of the analysis of Aggregates requires that the type be known, - -- and is therefore put off until resolution of the context. - -- Delta aggregates have a base component that determines the type of the - -- enclosing aggregate so its type can be ascertained earlier. This also - -- allows delta aggregates to appear in the context of a record type with - -- a private extension, as per the latest update of AI12-0127. + -- Most of the analysis of Aggregates requires that the type be known, and + -- is therefore put off until resolution of the context. Delta aggregates + -- have a base component that determines the enclosing aggregate type so + -- its type can be ascertained earlier. This also allows delta aggregates + -- to appear in the context of a record type with a private extension, as + -- per the latest update of AI12-0127. procedure Analyze_Aggregate (N : Node_Id) is begin @@ -425,14 +425,15 @@ package body Sem_Ch4 is if Nkind (N) = N_Delta_Aggregate then declare Base : constant Node_Id := Expression (N); + I : Interp_Index; It : Interp; begin Analyze (Base); - -- If the base is overloaded, propagate interpretations - -- to the enclosing aggregate. + -- If the base is overloaded, propagate interpretations to the + -- enclosing aggregate. if Is_Overloaded (Base) then Get_First_Interp (Base, I, It); @@ -1533,12 +1534,15 @@ package body Sem_Ch4 is and then Present (Limited_View (Scope (Etype (N)))) and then not Analyzed (Unit_Declaration_Node (Scope (Etype (N)))) then - Error_Msg_NE ("cannot call function that returns " - & "limited view of}", N, Etype (N)); Error_Msg_NE - ("\there must be a regular with_clause for package& " - & "in the current unit, or in some unit in its context", - N, Scope (Etype (N))); + ("cannot call function that returns limited view of}", + N, Etype (N)); + + Error_Msg_NE + ("\there must be a regular with_clause for package & in the " + & "current unit, or in some unit in its context", + N, Scope (Etype (N))); + Set_Etype (N, Any_Type); end if; end if; diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 33dbe48..57fb8e5 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -191,6 +191,8 @@ package Sem_Prag is Pragma_Remote_Types => False, Pragma_Shared_Passive => False, Pragma_Task_Dispatching_Policy => False, + Pragma_Unmodified => False, + Pragma_Unreferenced => False, Pragma_Warnings => False, others => True); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8646cc0..2626d3a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2442,8 +2442,8 @@ package body Sem_Res is elsif Nkind_In (N, N_Case_Expression, N_Character_Literal, - N_If_Expression, - N_Delta_Aggregate) + N_Delta_Aggregate, + N_If_Expression) then Set_Etype (N, Expr_Type); @@ -5197,11 +5197,11 @@ package body Sem_Res is -- user about it here. if Ekind (Typ) = E_Anonymous_Access_Type - and then Is_Controlled_Active (Desig_T) + and then Is_Controlled_Active (Desig_T) then - Error_Msg_N ("??anonymous access-to-controlled object will " - & "be finalized when its enclosing unit goes out " - & "of scope", N); + Error_Msg_N + ("??anonymous access-to-controlled object will be finalized " + & "when its enclosing unit goes out of scope", N); end if; end if; end if; @@ -7276,9 +7276,13 @@ package body Sem_Res is elsif Ekind (E) = E_Generic_Function then Error_Msg_N ("illegal use of generic function", N); - -- In Ada 83 an OUT parameter cannot be read + -- In Ada 83 an OUT parameter cannot be read, but attributes of + -- array types (i.e. bounds and length) are legal. elsif Ekind (E) = E_Out_Parameter + and then (Nkind (Parent (N)) /= N_Attribute_Reference + or else Is_Scalar_Type (Etype (E))) + and then (Nkind (Parent (N)) in N_Op or else Nkind (Parent (N)) = N_Explicit_Dereference or else Is_Assignment_Or_Object_Expression diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 3c3c9fb..f9f84ac 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -38,7 +38,7 @@ -- The tree contains not only the full syntactic representation of the -- program, but also the results of semantic analysis. In particular, the --- nodes for defining identifiers, defining character literals and defining +-- nodes for defining identifiers, defining character literals, and defining -- operator symbols, collectively referred to as entities, represent what -- would normally be regarded as the symbol table information. In addition a -- number of the tree nodes contain semantic information. @@ -213,7 +213,7 @@ package Sinfo is -- The Present function tests for Empty, which in this case signals the end -- of the list. First returns Empty immediately if the list is empty. - -- Present is defined in Atree, First and Next are defined in Nlists. + -- Present is defined in Atree; First and Next are defined in Nlists. -- The exceptions to this rule occur with {DEFINING_IDENTIFIERS} in all -- contexts, which is handled as described in the previous section, and @@ -389,7 +389,7 @@ package Sinfo is -- In the following node definitions, all fields, both syntactic and -- semantic, are documented. The one exception is in the case of entities - -- (defining identifiers, character literals and operator symbols), where + -- (defining identifiers, character literals, and operator symbols), where -- the usage of the fields depends on the entity kind. Entity fields are -- fully documented in the separate package Einfo. @@ -1116,7 +1116,7 @@ package Sinfo is -- complete a subprogram declaration. -- Corresponding_Spec_Of_Stub (Node2-Sem) - -- This field is present in subprogram, package, task and protected body + -- This field is present in subprogram, package, task, and protected body -- stubs where it points to the corresponding spec of the stub. Due to -- clashes in the structure of nodes, we cannot use Corresponding_Spec. @@ -1754,7 +1754,7 @@ package Sinfo is -- Is_Generic_Contract_Pragma (Flag2-Sem) -- This flag is present in N_Pragma nodes. It is set when the pragma is - -- a source construct, applies to a generic unit or its body and denotes + -- a source construct, applies to a generic unit or its body, and denotes -- one of the following contract-related annotations: -- Abstract_State -- Contract_Cases @@ -1910,7 +1910,7 @@ package Sinfo is -- nodes which emulate the body of a task unit. -- Is_Task_Master (Flag5-Sem) - -- A flag set in a Subprogram_Body, Block_Statement or Task_Body node to + -- A flag set in a Subprogram_Body, Block_Statement, or Task_Body node to -- indicate that the construct is a task master (i.e. has declared tasks -- or declares an access to a task type). @@ -2019,7 +2019,7 @@ package Sinfo is -- calls to Freeze_Expression. -- Next_Entity (Node2-Sem) - -- Present in defining identifiers, defining character literals and + -- Present in defining identifiers, defining character literals, and -- defining operator symbols (i.e. in all entities). The entities of a -- scope are chained, and this field is used as the forward pointer for -- this list. See Einfo for further details. @@ -2236,7 +2236,7 @@ package Sinfo is -- because Analyze wants to insert extra actions on this list. -- Rounded_Result (Flag18-Sem) - -- Present in N_Type_Conversion, N_Op_Divide and N_Op_Multiply nodes. + -- Present in N_Type_Conversion, N_Op_Divide, and N_Op_Multiply nodes. -- Used in the fixed-point cases to indicate that the result must be -- rounded as a result of the use of the 'Round attribute. Also used for -- integer N_Op_Divide nodes to indicate that the result should be @@ -2269,7 +2269,7 @@ package Sinfo is -- operation named (statically) in a dispatching call. -- Scope (Node3-Sem) - -- Present in defining identifiers, defining character literals and + -- Present in defining identifiers, defining character literals, and -- defining operator symbols (i.e. in all entities). The entities of a -- scope all use this field to reference the corresponding scope entity. -- See Einfo for further details. @@ -2341,7 +2341,7 @@ package Sinfo is -- always set to No_List. -- Treat_Fixed_As_Integer (Flag14-Sem) - -- This flag appears in operator nodes for divide, multiply, mod and rem + -- This flag appears in operator nodes for divide, multiply, mod, and rem -- on fixed-point operands. It indicates that the operands are to be -- treated as integer values, ignoring small values. This flag is only -- set as a result of expansion of fixed-point operations. Typically a @@ -2731,7 +2731,7 @@ package Sinfo is -- pain to allow these aspects to pervade the pragma syntax, and the -- representation of pragma nodes internally. So what we do is to -- replace these ASPECT_MARK forms with identifiers whose name is one - -- of the special internal names _Pre, _Post or _Type_Invariant. + -- of the special internal names _Pre, _Post, or _Type_Invariant. -- We do a similar replacement of these Aspect_Mark forms in the -- Expression of a pragma argument association for the cases of @@ -3028,8 +3028,8 @@ package Sinfo is -- [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION -- [[and INTERFACE_LIST] RECORD_EXTENSION_PART] - -- Note: ABSTRACT, LIMITED and record extension part are not permitted - -- in Ada 83 mode + -- Note: ABSTRACT, LIMITED, and record extension part are not permitted + -- in Ada 83 mode. -- Note: a record extension part is required if ABSTRACT is present @@ -3340,7 +3340,7 @@ package Sinfo is -- Subtype_Indication field or else the Access_Definition field. -- N_Component_Definition - -- Sloc points to ALIASED, ACCESS or to first token of subtype mark + -- Sloc points to ALIASED, ACCESS, or to first token of subtype mark -- Aliased_Present (Flag4) -- Null_Exclusion_Present (Flag11) -- Subtype_Indication (Node5) (set to Empty if not present) @@ -3488,7 +3488,7 @@ package Sinfo is -- end record -- | null record - -- Note: the Abstract_Present, Tagged_Present and Limited_Present + -- Note: the Abstract_Present, Tagged_Present, and Limited_Present -- flags appear only for a record definition appearing in a record -- type definition. @@ -4016,7 +4016,7 @@ package Sinfo is -- Instead the Attribute_Name and Expressions fields of the parent -- node (N_Attribute_Reference node) hold the information. - -- Note: if ACCESS, DELTA or DIGITS appears in an attribute + -- Note: if ACCESS, DELTA, or DIGITS appears in an attribute -- designator, then they are treated as identifiers internally -- rather than the keywords of the same name. @@ -7910,7 +7910,7 @@ package Sinfo is -- to aspects/pragmas Contract_Cases and Test_Case. The ordering in the -- list is in LIFO fashion. - -- Classifications contains pragmas that either declare, categorize or + -- Classifications contains pragmas that either declare, categorize, or -- establish dependencies between subprogram or package inputs and -- outputs. Currently the following pragmas appear in this list: -- Abstract_States @@ -13067,7 +13067,7 @@ package Sinfo is 4 => False, -- unused 5 => False), -- unused - -- Entries for Empty, Error and Unused. Even thought these have a Chars + -- Entries for Empty, Error, and Unused. Even though these have a Chars -- field for debugging purposes, they are not really syntactic fields, so -- we mark all fields as unused. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f3dbf60..78116ef 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,13 @@ 2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + * gnat.dg/unreferenced.adb: New testcase. + +2017-11-09 Ed Schonberg <schonberg@adacore.com> + + * gnat.dg/out_param.adb: New testcase. + +2017-11-09 Hristian Kirtchev <kirtchev@adacore.com> + * gnat.dg/elab3.adb, gnat.dg/elab3.ads, gnat.dg/elab3_pkg.adb, gnat.dg/elab3_pkg.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/out_param.adb b/gcc/testsuite/gnat.dg/out_param.adb new file mode 100644 index 0000000..14a2f94 --- /dev/null +++ b/gcc/testsuite/gnat.dg/out_param.adb @@ -0,0 +1,21 @@ +-- { dg-do compile } +-- { dg-options "-gnat83" } + +procedure Out_Param + (Source : in String; Dest : out String; Char_Count : out Natural) is +begin + --| Logic_Step: + --| Copy string Source to string Dest + Dest := (others => ' '); + Char_Count := 0; + if Source'Length > 0 and then Dest'Length > 0 then + if Source'Length > Dest'Length then + Char_Count := Dest'Length; + else + Dest (Dest'First .. (Dest'First + Source'Length - 1)) := Source; + Char_Count := Source'Length; + end if; + else + null; + end if; +end Out_Param; diff --git a/gcc/testsuite/gnat.dg/unreferenced.adb b/gcc/testsuite/gnat.dg/unreferenced.adb new file mode 100644 index 0000000..5b047c2 --- /dev/null +++ b/gcc/testsuite/gnat.dg/unreferenced.adb @@ -0,0 +1,11 @@ +-- { dg-do compile } +-- { dg-options "-gnatd.F" } + +procedure Unreferenced is + X : aliased Integer; + Y : access Integer := X'Access; + Z : Integer renames Y.all; + pragma Unreferenced (Z); +begin + null; +end Unreferenced; |