[multiple changes]

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

	* sem_prag.adb (Ensure_Aggregate_Form):
	Ensure that the name denoted by the Chars of a pragma argument
	association has the proper Sloc when converted into an aggregate.

2015-03-02  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Check_Private_Overriding): Capture
	Incomplete_Or_Partial_View in a constant. This is cleaner and
	more efficient.

2015-03-02  Gary Dismukes  <dismukes@adacore.com>

	* einfo.ads, exp_unst.ads: Minor reformatting.

2015-03-02  Ed Schonberg  <schonberg@adacore.com>

	* a-strsea.adb (Find_Token): Ensure that the range of iteration
	does not perform any improper character access. This prevents
	erroneous access in the unusual case of an empty string target
	and a From parameter less than Source'First.

2015-03-02  Robert Dewar  <dewar@adacore.com>

	* elists.adb (List_Length): Fix incorrect result.

From-SVN: r221111

gcc/ada/ChangeLog

@@ -1,3 +1,30 @@
+2015-03-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Ensure_Aggregate_Form):
+	Ensure that the name denoted by the Chars of a pragma argument
+	association has the proper Sloc when converted into an aggregate.
+
+2015-03-02  Bob Duff  <duff@adacore.com>
+
+	* sem_ch6.adb (Check_Private_Overriding): Capture
+	Incomplete_Or_Partial_View in a constant. This is cleaner and
+	more efficient.
+
+2015-03-02  Gary Dismukes  <dismukes@adacore.com>
+
+	* einfo.ads, exp_unst.ads: Minor reformatting.
+
+2015-03-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-strsea.adb (Find_Token): Ensure that the range of iteration
+	does not perform any improper character access. This prevents
+	erroneous access in the unusual case of an empty string target
+	and a From parameter less than Source'First.
+
+2015-03-02  Robert Dewar  <dewar@adacore.com>
+
+	* elists.adb (List_Length): Fix incorrect result.
+
 2015-03-02  Bob Duff  <duff@adacore.com>
 
 	* sem_ch6.adb (Check_Private_Overriding): Refine the legality

gcc/ada/a-strsea.adb

@@ -209,7 +209,11 @@ package body Ada.Strings.Search is
          raise Index_Error;
       end if;
 
-      for J in From .. Source'Last loop
+      --  If Source is the empty string, From may still be out of its
+      --  range.  The following ensures that in all cases there is no
+      --  possible erroneous access to a non-existing character.
+
+      for J in Integer'Max (From, Source'First) .. Source'Last loop
          if Belongs (Source (J), Set, Test) then
             First := J;
 

gcc/ada/einfo.ads

@@ -1999,7 +1999,7 @@ package Einfo is
 --       the case where we are unnesting nested subprograms (in which case it
 --       is also set for types and subtypes which are not static types, and
 --       that are referenced uplevel, as well as for subprograms that contain
---       uplevel references or call other subprogram, see Exp_unst for details.
+--       uplevel references or call other subprograms (Exp_Unst has details).
 
 --    Has_Visible_Refinement (Flag263)
 --       Defined in E_Abstract_State entities. Set when a state has at least
@@ -2978,7 +2978,7 @@ package Einfo is
 --       type is known to be a static type (defined as a discrete type with
 --       static bounds, a record all of whose component types are static types,
 --       or an array, all of whose bounds are of a static type, and also have
---       a component type that is a static type. See Set_Uplevel_Type for more
+--       a component type that is a static type). See Set_Uplevel_Type for more
 --       information on how this flag is used. Note that if Is_Static_Type is
 --       True, then it is never the case that the Has_Uplevel_Reference flag is
 --       set for the same type.

gcc/ada/elists.adb

@@ -302,6 +302,7 @@ package body Elists is
          if No (Elmt) then
             return N;
          else
+            N := N + 1;
             Next_Elmt (Elmt);
          end if;
       end loop;

gcc/ada/exp_unst.ads

@@ -195,7 +195,7 @@ package Exp_Unst is
    --   xxx is replaced by Tnn!(AREC1.xxx).all (where ! represents a call
    --   to unchecked conversion to convert the address to the access type
    --   and Tnn is a locally declared type that is "access all t", where t
-   --   is the type of the reference.
+   --   is the type of the reference).
 
    --   Note: the reason that we use Address as the component type in the
    --   declaration of AREC1T is that we may create this type before we see

gcc/ada/sem_ch6.adb

@@ -8906,24 +8906,27 @@ package body Sem_Ch6 is
 
          procedure Check_Private_Overriding (T : Entity_Id) is
 
-            function Overrides_Visible_Function return Boolean;
+            function Overrides_Visible_Function
+              (Partial_View : Entity_Id) return Boolean;
             --  True if S overrides a function in the visible part. The
             --  overridden function could be explicitly or implicitly declared.
 
-            function Overrides_Visible_Function return Boolean is
+            function Overrides_Visible_Function
+              (Partial_View : Entity_Id) return Boolean
+            is
             begin
                if not Is_Overriding or else not Has_Homonym (S) then
                   return False;
                end if;
 
-               if not Present (Incomplete_Or_Partial_View (T)) then
+               if not Present (Partial_View) then
                   return True;
                end if;
 
                --  Search through all the homonyms H of S in the current
                --  package spec, and return True if we find one that matches.
                --  Note that Parent (H) will be the declaration of the
-               --  Incomplete_Or_Partial_View of T for a match.
+               --  partial view of T for a match.
 
                declare
                   H : Entity_Id := S;
@@ -8936,8 +8939,7 @@ package body Sem_Ch6 is
                        (Parent (H),
                         N_Private_Extension_Declaration,
                         N_Private_Type_Declaration)
-                       and then Defining_Identifier (Parent (H)) =
+                       and then Defining_Identifier (Parent (H)) = Partial_View
-                                  Incomplete_Or_Partial_View (T)
                      then
                         return True;
                      end if;
@@ -8963,42 +8965,53 @@ package body Sem_Ch6 is
                   Error_Msg_N ("abstract subprograms must be visible "
                                & "(RM 3.9.3(10))!", S);
 
-               elsif Ekind (S) = E_Function
+               elsif Ekind (S) = E_Function then
-                 and then not Overrides_Visible_Function
+                  declare
-               then
+                     Partial_View : constant Entity_Id :=
-                  --  Here, S is "function ... return T;" declared in the
+                                      Incomplete_Or_Partial_View (T);
-                  --  private part, not overriding some visible operation.
-                  --  That's illegal in the tagged case (but not if the
-                  --  private type is untagged).
 
-                  if ((Present (Incomplete_Or_Partial_View (T))
+                  begin
-                      and then Is_Tagged_Type (Incomplete_Or_Partial_View (T)))
+                     if not Overrides_Visible_Function (Partial_View) then
-                    or else (not Present (Incomplete_Or_Partial_View (T))
+
+                        --  Here, S is "function ... return T;" declared in
+                        --  the private part, not overriding some visible
+                        --  operation.  That's illegal in the tagged case
+                        --  (but not if the private type is untagged).
+
+                        if ((Present (Partial_View)
+                              and then Is_Tagged_Type (Partial_View))
+                          or else (not Present (Partial_View)
                                     and then Is_Tagged_Type (T)))
                           and then T = Base_Type (Etype (S))
                         then
-                     Error_Msg_N ("private function with tagged result must"
+                           Error_Msg_N
+                             ("private function with tagged result must"
                               & " override visible-part function", S);
-                     Error_Msg_N ("\move subprogram to the visible part"
+                           Error_Msg_N
+                             ("\move subprogram to the visible part"
                               & " (RM 3.9.3(10))", S);
 
-                  --  AI05-0073: extend this test to the case of a function
+                        --  AI05-0073: extend this test to the case of a
-                  --  with a controlling access result.
+                        --  function with a controlling access result.
 
                         elsif Ekind (Etype (S)) = E_Anonymous_Access_Type
                           and then Is_Tagged_Type (Designated_Type (Etype (S)))
                           and then
-                      not Is_Class_Wide_Type (Designated_Type (Etype (S)))
+                            not Is_Class_Wide_Type
+                                  (Designated_Type (Etype (S)))
                           and then Ada_Version >= Ada_2012
                         then
                            Error_Msg_N
-                       ("private function with controlling access result "
+                             ("private function with controlling access "
-                        & "must override visible-part function", S);
+                              & "result must override visible-part function",
+                              S);
                            Error_Msg_N
                              ("\move subprogram to the visible part"
                               & " (RM 3.9.3(10))", S);
                         end if;
                      end if;
+                  end;
+               end if;
             end if;
          end Check_Private_Overriding;
 

gcc/ada/sem_prag.adb

@@ -5222,21 +5222,32 @@ package body Sem_Prag is
       ---------------------------
 
       procedure Ensure_Aggregate_Form (Arg : Node_Id) is
+         CFSD    : constant Boolean    := Get_Comes_From_Source_Default;
          Expr    : constant Node_Id    := Expression (Arg);
          Loc     : constant Source_Ptr := Sloc (Expr);
          Comps   : List_Id := No_List;
          Exprs   : List_Id := No_List;
-         Nam   : Name_Id;
+         Nam     : Name_Id := No_Name;
-
+         Nam_Loc : Source_Ptr;
-         CFSD : constant Boolean := Get_Comes_From_Source_Default;
-         --  Used to restore Comes_From_Source_Default
 
       begin
-         if Nkind (Arg) = N_Aspect_Specification then
+         --  The pragma argument is in positional form:
-            Nam := No_Name;
+
-         else
+         --    pragma Depends (Nam => ...)
-            pragma Assert (Nkind (Arg) = N_Pragma_Argument_Association);
+         --                    ^
+         --                    Chars field
+
+         --  Note that the Sloc of the Chars field is the Sloc of the pragma
+         --  argument association.
+
+         if Nkind (Arg) = N_Pragma_Argument_Association then
             Nam     := Chars (Arg);
+            Nam_Loc := Sloc (Arg);
+
+            --  Remove the pragma argument name as this will be captured in the
+            --  aggregate.
+
+            Set_Chars (Arg, No_Name);
          end if;
 
          --  The argument is already in aggregate form, but the presence of a
@@ -5279,17 +5290,10 @@ package body Sem_Prag is
          else
             Comps := New_List (
               Make_Component_Association (Loc,
-                Choices    => New_List (Make_Identifier (Loc, Chars (Arg))),
+                Choices    => New_List (Make_Identifier (Nam_Loc, Nam)),
                 Expression => Relocate_Node (Expr)));
          end if;
 
-         --  Remove the pragma argument name as this information has been
-         --  captured in the aggregate.
-
-         if Nkind (Arg) = N_Pragma_Argument_Association then
-            Set_Chars (Arg, No_Name);
-         end if;
-
          Set_Expression (Arg,
            Make_Aggregate (Loc,
              Component_Associations => Comps,