2015-03-04 Hristian Kirtchev <kirtchev@adacore.com>

	* 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  <dewar@adacore.com>

	* 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  <dross@adacore.com>

	* 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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@221180 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 128 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 065a991727a..294a43ed739 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2015-03-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
+	* 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  <dross@adacore.com>
+
+	* 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  <schonberg@adacore.com>
 
 	* 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 647d32891e2..f4a25861bff 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 86e282b3e17..fd94b1b1101 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 1f802d46c5a..e0d210e5334 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 a20a78904c0..58a768c9b1f 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 04c66f15c25..a69aa4f3de4 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 3d4c1b37ecd..284f034e1ad 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 072f728a64b..2ce40ac8cdb 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 5ac7f3268d1..dd51aa15073 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 abdee54920a..bbd294306b0 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 602c411e056..cae31f3f818 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