From 203876fcae96c1b556fbe86a70975597a547beaf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 4 Mar 2015 11:01:40 +0100 Subject: [PATCH] [multiple changes] 2015-03-04 Hristian Kirtchev * sem_prag.adb (Analyze_Abstract_State): Use routine Malformed_State_Error to issue general errors. (Analyze_Pragma): Diagnose a syntax error related to a state declaration with a simple option. (Malformed_State_Error): New routine. 2015-03-04 Robert Dewar * a-strsup.adb (Super_Slice): Deal with super flat case. * einfo.ads: Minor reformatting. * s-imgdec.adb (Set_Decimal_Digits): Add comment about possibly redundant code. 2015-03-04 Claire Dross * a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads, a-cforse.ads, a-cofove.ads: Use Default_Initial_Condition on formal containers. From-SVN: r221180 --- gcc/ada/ChangeLog | 21 +++++++++++++++++++++ gcc/ada/a-cfdlli.ads | 4 ++-- gcc/ada/a-cfhama.ads | 4 ++-- gcc/ada/a-cfhase.ads | 4 ++-- gcc/ada/a-cforma.ads | 4 ++-- gcc/ada/a-cforse.ads | 4 ++-- gcc/ada/a-cofove.ads | 4 ++-- gcc/ada/a-strsup.adb | 17 ++++++++++++----- gcc/ada/einfo.ads | 46 +++++++++++++++++++++++----------------------- gcc/ada/s-imgdec.adb | 18 ++++++++++++++++++ gcc/ada/sem_prag.adb | 49 ++++++++++++++++++++++++++++++++++++++++++------- 11 files changed, 128 insertions(+), 47 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 065a991..294a43e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2015-03-04 Hristian Kirtchev + + * sem_prag.adb (Analyze_Abstract_State): Use routine + Malformed_State_Error to issue general errors. + (Analyze_Pragma): Diagnose a syntax error related to a state + declaration with a simple option. + (Malformed_State_Error): New routine. + +2015-03-04 Robert Dewar + + * a-strsup.adb (Super_Slice): Deal with super flat case. + * einfo.ads: Minor reformatting. + * s-imgdec.adb (Set_Decimal_Digits): Add comment about possibly + redundant code. + +2015-03-04 Claire Dross + + * a-cfdlli.ads, a-cfhase.ads, a-cforma.ads, a-cfhama.ads, + a-cforse.ads, a-cofove.ads: Use Default_Initial_Condition on formal + containers. + 2015-03-04 Ed Schonberg * sem_warn.adb (Check_References): When checking for an unused diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads index 647d328..f4a2586 100644 --- a/gcc/ada/a-cfdlli.ads +++ b/gcc/ada/a-cfdlli.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -72,7 +72,7 @@ is Next => Next, Has_Element => Has_Element, Element => Element), - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (List); pragma Preelaborable_Initialization (List); type Cursor is private; diff --git a/gcc/ada/a-cfhama.ads b/gcc/ada/a-cfhama.ads index 86e282b..fd94b1b 100644 --- a/gcc/ada/a-cfhama.ads +++ b/gcc/ada/a-cfhama.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -76,7 +76,7 @@ is Next => Next, Has_Element => Has_Element, Element => Element), - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (Map); pragma Preelaborable_Initialization (Map); type Cursor is private; diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads index 1f802d4..e0d210e 100644 --- a/gcc/ada/a-cfhase.ads +++ b/gcc/ada/a-cfhase.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -78,7 +78,7 @@ is Next => Next, Has_Element => Has_Element, Element => Element), - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (Set); pragma Preelaborable_Initialization (Set); type Cursor is private; diff --git a/gcc/ada/a-cforma.ads b/gcc/ada/a-cforma.ads index a20a7890..58a768c 100644 --- a/gcc/ada/a-cforma.ads +++ b/gcc/ada/a-cforma.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -80,7 +80,7 @@ is Next => Next, Has_Element => Has_Element, Element => Element), - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (Map); pragma Preelaborable_Initialization (Map); type Cursor is private; diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads index 04c66f1..a69aa4f 100644 --- a/gcc/ada/a-cforse.ads +++ b/gcc/ada/a-cforse.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -79,7 +79,7 @@ is Next => Next, Has_Element => Has_Element, Element => Element), - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (Set); pragma Preelaborable_Initialization (Set); type Cursor is private; diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads index 3d4c1b3..284f034 100644 --- a/gcc/ada/a-cofove.ads +++ b/gcc/ada/a-cofove.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -61,7 +61,7 @@ is Count_Type range 0 .. Count_Type (Index_Type'Last - Index_Type'First + 1); type Vector (Capacity : Capacity_Range) is limited private with - Default_Initial_Condition; + Default_Initial_Condition => Is_Empty (Vector); -- In the bounded case, Capacity is the capacity of the container, which -- never changes. In the unbounded case, Capacity is the initial capacity -- of the container, and operations such as Reserve_Capacity and Append can diff --git a/gcc/ada/a-strsup.adb b/gcc/ada/a-strsup.adb index 072f728..2ce40ac 100644 --- a/gcc/ada/a-strsup.adb +++ b/gcc/ada/a-strsup.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1473,6 +1473,9 @@ package body Ada.Strings.Superbounded is raise Index_Error; end if; + -- Note: in this case, superflat bounds are not a problem, we just + -- get the null string in accordance with normal Ada slice rules. + R := Source.Data (Low .. High); end return; end Super_Slice; @@ -1490,7 +1493,9 @@ package body Ada.Strings.Superbounded is raise Index_Error; end if; - Result.Current_Length := High - Low + 1; + -- Note: the Max operation here deals with the superflat case + + Result.Current_Length := Integer'Max (0, High - Low + 1); Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High); end return; end Super_Slice; @@ -1506,10 +1511,12 @@ package body Ada.Strings.Superbounded is or else High > Source.Current_Length then raise Index_Error; - else - Target.Current_Length := High - Low + 1; - Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); end if; + + -- Note: the Max operation here deals with the superflat case + + Target.Current_Length := Integer'Max (0, High - Low + 1); + Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); end Super_Slice; ---------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 5ac7f32..dd51aa1 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3234,12 +3234,12 @@ package Einfo is -- derived from a type with a clause present. -- Master_Id (Node17) --- Defined in access types and subtypes. Empty unless Has_Task is --- set for the designated type, in which case it points to the entity --- for the Master_Id for the access type master. Also set for access-to- --- limited-class-wide types whose root may be extended with task --- components, and for access-to-limited-interfaces because they can be --- used to reference tasks implementing such interface. +-- Defined in access types and subtypes. Empty unless Has_Task is set for +-- the designated type, in which case it points to the entity for the +-- Master_Id for the access type master. Also set for access-to-limited- +-- class-wide types whose root may be extended with task components, and +-- for access-to-limited-interfaces because they can be used to reference +-- tasks implementing such interface. -- Materialize_Entity (Flag168) -- Defined in all entities. Set only for renamed obects which should be @@ -3317,10 +3317,10 @@ package Einfo is -- not all of the fields in a partially initialized record). The code -- generator should instead use the flag Is_True_Constant. -- --- For the purposes of this warning, the default assignment of --- access variables to null is not considered the assignment of --- of a value (so the warning can be given for code that relies --- on this initial null value, when no other value is ever set). +-- For the purposes of this warning, the default assignment of access +-- variables to null is not considered the assignment of a value (so +-- the warning can be given for code that relies on this initial null +-- value when no other value is ever set). -- -- In variables and out parameters, if this flag is set after full -- processing of the corresponding declarative unit, it indicates that @@ -3333,10 +3333,10 @@ package Einfo is -- statement sequence, the meaning of the flag is "not set yet", and -- once this analysis is complete the flag means "never assigned". --- Note: for variables appearing in package declarations, this flag --- is never set. That is because there is no way to tell if some --- client modifies the variable (or in the case of variables in the --- private part, if some child unit modifies the variables). +-- Note: for variables appearing in package declarations, this flag is +-- never set. That is because there is no way to tell if some client +-- modifies the variable (or, in the case of variables in the private +-- part, if some child unit modifies the variables). -- Note: in the case of renamed objects, the flag must be set in the -- ultimate renamed object. Clients noting a possible modification @@ -3358,12 +3358,12 @@ package Einfo is -- discriminants in the record. -- Next_Discriminant (synthesized) --- Applies to discriminants returned by First/Next_Discriminant. --- Returns the next language-defined (ie: perhaps non-girder) --- discriminant by following the chain of declared entities as long as --- the kind of the entity corresponds to a discriminant. Note that the --- discriminants might be the only components of the record. --- Returns Empty if there are no more. +-- Applies to discriminants returned by First/Next_Discriminant. Returns +-- the next language-defined (ie: perhaps non-girder) discriminant by +-- following the chain of declared entities as long as the kind of the +-- entity corresponds to a discriminant. Note that the discriminants +-- might be the only components of the record. Returns Empty if there +-- are no more discriminants. -- Next_Entity (Node2) -- Defined in all entities. The entities of a scope are chained, with @@ -3374,9 +3374,9 @@ package Einfo is -- field are in Sinfo. -- Next_Formal (synthesized) --- Applies to the entity for a formal parameter. Returns the next --- formal parameter of the subprogram or subprogram type. Returns --- Empty if there are no more formals. +-- Applies to the entity for a formal parameter. Returns the next formal +-- parameter of the subprogram or subprogram type. Returns Empty if there +-- are no more formals. -- Next_Formal_With_Extras (synthesized) -- Applies to the entity for a formal parameter. Returns the next diff --git a/gcc/ada/s-imgdec.adb b/gcc/ada/s-imgdec.adb index abdee54..bbd2943 100644 --- a/gcc/ada/s-imgdec.adb +++ b/gcc/ada/s-imgdec.adb @@ -330,6 +330,24 @@ package body System.Img_Dec is DA := DA - LZ; if DA < ND then + + -- Note: it is definitely possible for the above condition + -- to be True, for example: + + -- V => 1234, Scale => 5, Fore => 0, After => 1, Exp => 0 + + -- but in this case DA = 0, ND = 1, FD = 1, FD + DA-1 = 0 + -- so the arguments in the call are (1, 0) meaning that no + -- digits are output. + + -- No obvious example exists where the following call to + -- Set_Digits actually outputs some digits, but we lack a + -- proof that no such example exists. + + -- So it is safer to retain this call, even though as a + -- result it is hard (or perhaps impossible) to create a + -- coverage test for the inlined code of the call. + Set_Digits (FD, FD + DA - 1); else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 602c411..cae31f3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9526,6 +9526,12 @@ package body Sem_Prag is -- visibility chain. Pack_Id denotes the entity or the related -- package where pragma Abstract_State appears. + procedure Malformed_State_Error (State : Node_Id); + -- Emit an error concerning the illegal declaration of abstract + -- state State. This routine diagnoses syntax errors that lead to + -- a different parse tree. The error is issued regardless of the + -- SPARK mode in effect. + ---------------------------- -- Analyze_Abstract_State -- ---------------------------- @@ -10059,11 +10065,10 @@ package body Sem_Prag is Next (Opt); end loop; - -- Any other attempt to declare a state is illegal. This is a - -- syntax error, always report. + -- Any other attempt to declare a state is illegal else - Error_Msg_N ("malformed abstract state declaration", State); + Malformed_State_Error (State); return; end if; @@ -10096,11 +10101,29 @@ package body Sem_Prag is end if; end Analyze_Abstract_State; + --------------------------- + -- Malformed_State_Error -- + --------------------------- + + procedure Malformed_State_Error (State : Node_Id) is + begin + Error_Msg_N ("malformed abstract state declaration", State); + + -- An abstract state with a simple option is being declared + -- with "=>" rather than the legal "with". The state appears + -- as a component association. + + if Nkind (State) = N_Component_Association then + Error_Msg_N ("\\use WITH to specify simple option", State); + end if; + end Malformed_State_Error; + -- Local variables Pack_Decl : Node_Id; Pack_Id : Entity_Id; State : Node_Id; + States : Node_Id; -- Start of processing for Abstract_State @@ -10137,22 +10160,34 @@ package body Sem_Prag is Set_Is_Ghost_Entity (Pack_Id); end if; - State := Expression (Get_Argument (N)); + States := Expression (Get_Argument (N)); -- Multiple non-null abstract states appear as an aggregate - if Nkind (State) = N_Aggregate then - State := First (Expressions (State)); + if Nkind (States) = N_Aggregate then + State := First (Expressions (States)); while Present (State) loop Analyze_Abstract_State (State, Pack_Id); Next (State); end loop; + -- An abstract state with a simple option is being illegaly + -- declared with "=>" rather than "with". In this case the + -- state declaration appears as a component association. + + if Present (Component_Associations (States)) then + State := First (Component_Associations (States)); + while Present (State) loop + Malformed_State_Error (State); + Next (State); + end loop; + end if; + -- Various forms of a single abstract state. Note that these may -- include malformed state declarations. else - Analyze_Abstract_State (State, Pack_Id); + Analyze_Abstract_State (States, Pack_Id); end if; -- Save the pragma for retrieval by other tools -- 2.7.4