[multiple changes]

2015-02-05  Javier Miranda  <miranda@adacore.com>

	* errout.adb (Error_Msg_PT): Add missing error.
	* sem_ch6.adb (Check_Synchronized_Overriding): Check the missing
	RM rule.  Code cleanup.
	* exp_ch9.adb (Build_Wrapper_Spec): Propagate "constant" in
	anonymous access types.  Found working on the tests. Code cleanup.

2015-02-05  Vincent Celier  <celier@adacore.com>

	* prj-dect.adb (Parse_Attribute_Declaration): Continue scanning
	when there are incomplete withs.
	* prj-nmsc.adb (Process_Naming): Do not try to get the value
	of an element when it is nil.
	(Check_Naming): Do not check a nil suffix for illegality
	* prj-proc.adb (Expression): Do not process an empty term.
	* prj-strt.adb (Attribute_Reference): If attribute cannot be
	found, parse a possible index to avoid cascading errors.

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

	* sem_aux.adb (Is_Derived_Type): A subprogram_type generated
	for an access_to_subprogram declaration is not a derived type.

From-SVN: r220451

9 files changed, 141 insertions, 86 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6da97c7..d9ef29a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2015-02-05  Javier Miranda  <miranda@adacore.com>
+
+	* errout.adb (Error_Msg_PT): Add missing error.
+	* sem_ch6.adb (Check_Synchronized_Overriding): Check the missing
+	RM rule.  Code cleanup.
+	* exp_ch9.adb (Build_Wrapper_Spec): Propagate "constant" in
+	anonymous access types.  Found working on the tests. Code cleanup.
+
+2015-02-05  Vincent Celier  <celier@adacore.com>
+
+	* prj-dect.adb (Parse_Attribute_Declaration): Continue scanning
+	when there are incomplete withs.
+	* prj-nmsc.adb (Process_Naming): Do not try to get the value
+	of an element when it is nil.
+	(Check_Naming): Do not check a nil suffix for illegality
+	* prj-proc.adb (Expression): Do not process an empty term.
+	* prj-strt.adb (Attribute_Reference): If attribute cannot be
+	found, parse a possible index to avoid cascading errors.
+
+2015-02-05  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aux.adb (Is_Derived_Type): A subprogram_type generated
+	for an access_to_subprogram declaration is not a derived type.
+
 2015-02-05  Robert Dewar  <dewar@adacore.com>
 
 	* errout.adb (Error_Msg_Internal): For non-serious error set
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 86ea13f..d79cafa 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -686,9 +686,16 @@ package body Errout is
         ("illegal overriding of subprogram inherited from interface", E);
 
       Error_Msg_Sloc := Sloc (Iface_Prim);
-      Error_Msg_N
-        ("\first formal of & declared # must be of mode `OUT`, `IN OUT` " &
-         "or access-to-variable", E);
+
+      if Ekind (E) = E_Function then
+         Error_Msg_N
+           ("\first formal of & declared # must be of mode `IN` " &
+            "or access-to-constant", E);
+      else
+         Error_Msg_N
+           ("\first formal of & declared # must be of mode `OUT`, `IN OUT` " &
+            "or access-to-variable", E);
+      end if;
    end Error_Msg_PT;
 
    -----------------
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 4674da7..9d467c3 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -2640,10 +2640,11 @@ package body Exp_Ch9 is
                Obj_Param_Typ :=
                  Make_Access_Definition (Loc,
                    Subtype_Mark =>
-                     New_Occurrence_Of (Obj_Typ, Loc));
-               Set_Null_Exclusion_Present (Obj_Param_Typ,
-                 Null_Exclusion_Present (Parameter_Type (First_Param)));
-
+                     New_Occurrence_Of (Obj_Typ, Loc),
+                   Null_Exclusion_Present =>
+                     Null_Exclusion_Present (Parameter_Type (First_Param)),
+                   Constant_Present =>
+                     Constant_Present (Parameter_Type (First_Param)));
             else
                Obj_Param_Typ := New_Occurrence_Of (Obj_Typ, Loc);
             end if;
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 672c454..e0f6dcb 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -582,7 +582,7 @@ package body Prj.Dect is
                   The_Project := Imported_Or_Extended_Project_Of
                                    (Current_Project, In_Tree, Token_Name);
 
-                  if No (The_Project) then
+                  if No (The_Project) and then not In_Tree.Incomplete_With then
                      Error_Msg (Flags, "unknown project", Location);
                      Scan (In_Tree); --  past the project name
 
@@ -617,33 +617,37 @@ package body Prj.Dect is
                                  Get_Name_String
                                    (Name_Of (Current_Package, In_Tree)),
                                  Token_Ptr);
+                              Scan (In_Tree); --  past the package name
 
                            else
-                              The_Package :=
-                                First_Package_Of (The_Project, In_Tree);
-
-                              --  Look for the package node
-
-                              while Present (The_Package)
-                                and then
-                                Name_Of (The_Package, In_Tree) /= Token_Name
-                              loop
+                              if Present (The_Project) then
                                  The_Package :=
-                                   Next_Package_In_Project
-                                     (The_Package, In_Tree);
-                              end loop;
-
-                              --  If the package cannot be found in the
-                              --  project, issue an error.
-
-                              if No (The_Package) then
-                                 The_Project := Empty_Node;
-                                 Error_Msg_Name_2 := Project_Name;
-                                 Error_Msg_Name_1 := Token_Name;
-                                 Error_Msg
-                                   (Flags,
-                                    "package % not declared in project %",
-                                    Token_Ptr);
+                                   First_Package_Of (The_Project, In_Tree);
+
+                                 --  Look for the package node
+
+                                 while Present (The_Package)
+                                   and then
+                                     Name_Of (The_Package, In_Tree) /=
+                                     Token_Name
+                                 loop
+                                    The_Package :=
+                                      Next_Package_In_Project
+                                        (The_Package, In_Tree);
+                                 end loop;
+
+                                 --  If the package cannot be found in the
+                                 --  project, issue an error.
+
+                                 if No (The_Package) then
+                                    The_Project := Empty_Node;
+                                    Error_Msg_Name_2 := Project_Name;
+                                    Error_Msg_Name_1 := Token_Name;
+                                    Error_Msg
+                                      (Flags,
+                                       "package % not declared in project %",
+                                       Token_Ptr);
+                                 end if;
                               end if;
 
                               Scan (In_Tree); --  past the package name
@@ -653,7 +657,7 @@ package body Prj.Dect is
                   end if;
                end if;
 
-               if Present (The_Project) then
+               if Present (The_Project) or else In_Tree.Incomplete_With then
 
                   --  Looking for '<same attribute name>
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 3bfe2d8..9c7a8d0 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2000-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-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- --
@@ -1803,7 +1803,10 @@ package body Prj.Nmsc is
                   Lang_Index := Get_Language_From_Name
                     (Project, Get_Name_String (Element.Index));
 
-                  if Lang_Index /= No_Language_Index then
+                  if Lang_Index /= No_Language_Index and then
+                     Element.Value.Kind = Single and then
+                     Element.Value.Value /= No_Name
+                  then
                      case Current_Array.Name is
                         when Name_Spec_Suffix | Name_Specification_Suffix =>
 
@@ -4287,7 +4290,9 @@ package body Prj.Nmsc is
                   Shared                  => Shared);
             end if;
 
-            if Suffix /= Nil_Variable_Value then
+            if Suffix /= Nil_Variable_Value and then
+               Suffix.Value /= No_Name
+            then
                Lang_Id.Config.Naming_Data.Spec_Suffix :=
                    File_Name_Type (Suffix.Value);
 
@@ -4320,7 +4325,9 @@ package body Prj.Nmsc is
                     Shared                  => Shared);
             end if;
 
-            if Suffix /= Nil_Variable_Value then
+            if Suffix /= Nil_Variable_Value and then
+               Suffix.Value /= No_Name
+            then
                Lang_Id.Config.Naming_Data.Body_Suffix :=
                  File_Name_Type (Suffix.Value);
 
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index ac2cc66..0107aa0 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -539,10 +539,12 @@ package body Prj.Proc is
       The_Term := First_Term;
       while Present (The_Term) loop
          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
-         Current_Term_Kind :=
-           Kind_Of (The_Current_Term, From_Project_Node_Tree);
 
-         case Current_Term_Kind is
+         if The_Current_Term /= Empty_Node then
+            Current_Term_Kind :=
+              Kind_Of (The_Current_Term, From_Project_Node_Tree);
+
+            case Current_Term_Kind is
 
             when N_Literal_String =>
 
@@ -578,7 +580,7 @@ package body Prj.Proc is
                      else
                         Shared.String_Elements.Table
                           (Last).Next := String_Element_Table.Last
-                                       (Shared.String_Elements);
+                                           (Shared.String_Elements);
                      end if;
 
                      Last := String_Element_Table.Last
@@ -586,8 +588,8 @@ package body Prj.Proc is
 
                      Shared.String_Elements.Table (Last) :=
                        (Value         => String_Value_Of
-                                           (The_Current_Term,
-                                            From_Project_Node_Tree),
+                          (The_Current_Term,
+                           From_Project_Node_Tree),
                         Index         => Source_Index_Of
                                            (The_Current_Term,
                                             From_Project_Node_Tree),
@@ -743,7 +745,7 @@ package body Prj.Proc is
                      The_Package := The_Project.Decl.Packages;
                      while The_Package /= No_Package
                        and then Shared.Packages.Table (The_Package).Name /=
-                          The_Name
+                                The_Name
                      loop
                         The_Package :=
                           Shared.Packages.Table (The_Package).Next;
@@ -753,7 +755,7 @@ package body Prj.Proc is
                        (The_Package /= No_Package, "package not found.");
 
                   elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
-                                                        N_Attribute_Reference
+                        N_Attribute_Reference
                   then
                      The_Package := No_Package;
                   end if;
@@ -886,8 +888,8 @@ package body Prj.Proc is
 
                         else
                            if Expression_Kind_Of
-                                (The_Current_Term, From_Project_Node_Tree) =
-                                                                        List
+                               (The_Current_Term, From_Project_Node_Tree) =
+                                                                       List
                            then
                               The_Variable :=
                                 (Project  => Project,
@@ -1047,8 +1049,8 @@ package body Prj.Proc is
 
                               else
                                  Shared.String_Elements.Table (Last).Next :=
-                                     String_Element_Table.Last
-                                       (Shared.String_Elements);
+                                   String_Element_Table.Last
+                                     (Shared.String_Elements);
                               end if;
 
                               Last :=
@@ -1059,8 +1061,8 @@ package body Prj.Proc is
                                 (Value         => The_Variable.Value,
                                  Display_Value => No_Name,
                                  Location      => Location_Of
-                                                    (The_Current_Term,
-                                                     From_Project_Node_Tree),
+                                                   (The_Current_Term,
+                                                    From_Project_Node_Tree),
                                  Flag          => False,
                                  Next          => Nil_String,
                                  Index         => 0);
@@ -1108,7 +1110,7 @@ package body Prj.Proc is
                                        Index        => 0);
 
                                     The_List := Shared.String_Elements.Table
-                                        (The_List).Next;
+                                                              (The_List).Next;
                                  end loop;
                               end;
                         end case;
@@ -1334,10 +1336,10 @@ package body Prj.Proc is
                                     String_Element_Table.Increment_Last
                                       (Shared.String_Elements);
                                     Shared.String_Elements.Table (Last).Next :=
-                                        String_Element_Table.Last
-                                          (Shared.String_Elements);
+                                         String_Element_Table.Last
+                                           (Shared.String_Elements);
                                     Last := String_Element_Table.Last
-                                        (Shared.String_Elements);
+                                              (Shared.String_Elements);
                                  end if;
                               end loop;
 
@@ -1366,7 +1368,8 @@ package body Prj.Proc is
                   "illegal node kind in an expression");
                raise Program_Error;
 
-         end case;
+            end case;
+         end if;
 
          The_Term := Next_Term (The_Term, From_Project_Node_Tree);
       end loop;
diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb
index a6b0b38..8956e97 100644
--- a/gcc/ada/prj-strt.adb
+++ b/gcc/ada/prj-strt.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -207,6 +207,20 @@ package body Prj.Strt is
 
             Scan (In_Tree);
 
+            --  Skip a possible index for an associative array
+
+            if Token = Tok_Left_Paren then
+               Scan (In_Tree);
+
+               if Token = Tok_String_Literal then
+                  Scan (In_Tree);
+
+                  if Token = Tok_Right_Paren then
+                     Scan (In_Tree);
+                  end if;
+               end if;
+            end if;
+
          else
             --  Give its characteristics to this attribute reference
 
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 68104b9..09dcc6c 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -981,6 +981,7 @@ package body Sem_Aux is
       if Is_Type (Ent)
         and then Base_Type (Ent) /= Root_Type (Ent)
         and then not Is_Class_Wide_Type (Ent)
+        and then Ekind (Ent) /= E_Subprogram_Type
       then
          if not Is_Numeric_Type (Root_Type (Ent)) then
             return True;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 575f0b6..94249fa 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9259,7 +9259,6 @@ package body Sem_Ch6 is
          declare
             Candidate : Entity_Id := Empty;
             Hom       : Entity_Id := Empty;
-            Iface_Typ : Entity_Id;
             Subp      : Entity_Id := Empty;
 
          begin
@@ -9334,8 +9333,23 @@ package body Sem_Ch6 is
                  and then Etype (Result_Definition (Parent (Def_Id))) =
                           Etype (Result_Definition (Parent (Subp)))
                then
-                  Overridden_Subp := Subp;
-                  return;
+                  Candidate := Subp;
+
+                  --  If an inherited subprogram is implemented by a protected
+                  --  function, then the first parameter of the inherited
+                  --  subprogram shall be of mode in, but not an
+                  --  access-to-variable parameter (RM 9.4(11/9)
+
+                  if Present (First_Formal (Subp))
+                    and then Ekind (First_Formal (Subp)) = E_In_Parameter
+                    and then
+                      (not Is_Access_Type (Etype (First_Formal (Subp)))
+                         or else
+                       Is_Access_Constant (Etype (First_Formal (Subp))))
+                  then
+                     Overridden_Subp := Subp;
+                     return;
+                  end if;
                end if;
 
                Hom := Homonym (Hom);
@@ -9343,29 +9357,9 @@ package body Sem_Ch6 is
 
             --  After examining all candidates for overriding, we are left with
             --  the best match which is a mode incompatible interface routine.
-            --  Do not emit an error if the Expander is active since this error
-            --  will be detected later on after all concurrent types are
-            --  expanded and all wrappers are built. This check is meant for
-            --  spec-only compilations.
-
-            if Present (Candidate) and then not Expander_Active then
-               Iface_Typ :=
-                 Find_Parameter_Type (Parent (First_Formal (Candidate)));
-
-               --  Def_Id is primitive of a protected type, declared inside the
-               --  type, and the candidate is primitive of a limited or
-               --  synchronized interface.
 
-               if In_Scope
-                 and then Is_Protected_Type (Typ)
-                 and then
-                   (Is_Limited_Interface (Iface_Typ)
-                     or else Is_Protected_Interface (Iface_Typ)
-                     or else Is_Synchronized_Interface (Iface_Typ)
-                     or else Is_Task_Interface (Iface_Typ))
-               then
-                  Error_Msg_PT (Def_Id, Candidate);
-               end if;
+            if In_Scope and then Present (Candidate) then
+               Error_Msg_PT (Def_Id, Candidate);
             end if;
 
             Overridden_Subp := Candidate;