[multiple changes]

2015-01-30  Gary Dismukes  <dismukes@adacore.com>

	* freeze.adb: Minor reformatting.

2015-01-30  Javier Miranda  <miranda@adacore.com>

	* errout.ads (Error_Msg_PT): Replace Node_Id by Entity_Id and
	improve its documentation.
	* errout.adb (Error_Msg_PT): Improve the error message.
	* sem_ch6.adb (Check_Conformance): Update call to Error_Msg_PT.
	(Check_Synchronized_Overriding): Update call to Error_Msg_PT.
	* sem_ch3.adb (Check_Abstract_Overriding): Code cleanup.

2015-01-30  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Known_Condition): Do special casing of
	message for False case.

2015-01-30  Doug Rupp  <rupp@adacore.com>

	* s-vxwext-kernel.ads (Task_Cont): Remove imported subprogram body.
	* s-vxwext-kernel.adb (Task_Cont): New subpprogram body specialized for
	kernel.

From-SVN: r220284

9 files changed, 99 insertions, 59 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 593ea39..6a0dbd2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 2015-01-30  Gary Dismukes  <dismukes@adacore.com>
 
+	* freeze.adb: Minor reformatting.
+
+2015-01-30  Javier Miranda  <miranda@adacore.com>
+
+	* errout.ads (Error_Msg_PT): Replace Node_Id by Entity_Id and
+	improve its documentation.
+	* errout.adb (Error_Msg_PT): Improve the error message.
+	* sem_ch6.adb (Check_Conformance): Update call to Error_Msg_PT.
+	(Check_Synchronized_Overriding): Update call to Error_Msg_PT.
+	* sem_ch3.adb (Check_Abstract_Overriding): Code cleanup.
+
+2015-01-30  Robert Dewar  <dewar@adacore.com>
+
+	* sem_warn.adb (Warn_On_Known_Condition): Do special casing of
+	message for False case.
+
+2015-01-30  Doug Rupp  <rupp@adacore.com>
+
+	* s-vxwext-kernel.ads (Task_Cont): Remove imported subprogram body.
+	* s-vxwext-kernel.adb (Task_Cont): New subpprogram body specialized for
+	kernel.
+
+2015-01-30  Gary Dismukes  <dismukes@adacore.com>
+
 	* sem_attr.adb (Declared_Within_Generic_Unit):
 	New function to test whether an entity is declared within the
 	declarative region of a given generic unit.
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 803e2d4..d04d132 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.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- --
@@ -680,14 +680,14 @@ package body Errout is
    -- Error_Msg_PT --
    ------------------
 
-   procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id) is
+   procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id) is
    begin
-      Error_Msg_NE
-        ("first formal of & must be of mode `OUT`, `IN OUT` or " &
-         "access-to-variable", Typ, Subp);
       Error_Msg_N
-        ("\in order to be overridden by protected procedure or entry " &
-         "(RM 9.4(11.9/2))", Typ);
+        ("illegal overriding of subprogram inherited from interface", E);
+
+      Error_Msg_Sloc := Sloc (Iface_Prim);
+      Error_Msg_N
+        ("\first formal of & declared # has wrong mode (RM 9.4(11.9))", E);
    end Error_Msg_PT;
 
    -----------------
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 6ca4549..6105880 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -848,9 +848,10 @@ package Errout is
    --  run-time mode or no run-time mode (as appropriate). In the former case,
    --  the name of the library is output if available.
 
-   procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id);
-   --  Posts an error on the protected type declaration Typ indicating wrong
-   --  mode of the first formal of protected type primitive Subp.
+   procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id);
+   --  Posts an error on protected type entry or subprogram E (referencing its
+   --  overridden interface primitive Iface_Prim) indicating wrong mode of the
+   --  first formal (RM 9.4(11.9/3))
 
    procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
    --  If not operating in Ada 2012 mode, posts errors complaining that Feature
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 12154a0..3c88297 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1800,7 +1800,7 @@ package body Freeze is
 
          --  Historical note: We used to create a finalization master for an
          --  access type whose designated type is not controlled, but contains
-         --  private controlled compoments. This form of post processing is no
+         --  private controlled compoments. This form of postprocessing is no
          --  longer needed because the finalization master is now created when
          --  the access type is frozen (see Exp_Ch3.Freeze_Type).
 
diff --git a/gcc/ada/s-vxwext-kernel.adb b/gcc/ada/s-vxwext-kernel.adb
index 584de4f..404e9aa 100644
--- a/gcc/ada/s-vxwext-kernel.adb
+++ b/gcc/ada/s-vxwext-kernel.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---            Copyright (C) 2008-2014, Free Software Foundation, Inc.       --
+--            Copyright (C) 2008-2015, Free Software Foundation, Inc.       --
 --                                                                          --
 -- GNARL 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- --
@@ -86,6 +86,17 @@ package body System.VxWorks.Ext is
    end taskMaskAffinitySet;
 
    --------------
+   -- taskCont --
+   --------------
+
+   function Task_Cont (tid : t_id) return int is
+      function taskCont (tid : t_id) return int;
+      pragma Import (C, taskCont, "taskCont");
+   begin
+      return taskCont (tid);
+   end Task_Cont;
+
+   --------------
    -- taskStop --
    --------------
 
diff --git a/gcc/ada/s-vxwext-kernel.ads b/gcc/ada/s-vxwext-kernel.ads
index c8cba65..dfdbcf1 100644
--- a/gcc/ada/s-vxwext-kernel.ads
+++ b/gcc/ada/s-vxwext-kernel.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   S p e c                                --
 --                                                                          --
---            Copyright (C) 2008-2014, Free Software Foundation, Inc.       --
+--            Copyright (C) 2008-2015, Free Software Foundation, Inc.       --
 --                                                                          --
 -- GNARL 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- --
@@ -73,7 +73,7 @@ package System.VxWorks.Ext is
    pragma Convention (C, semDelete);
 
    function Task_Cont (tid : t_id) return int;
-   pragma Import (C, Task_Cont, "taskCont");
+   pragma Convention (C, Task_Cont);
 
    function Task_Stop (tid : t_id) return int;
    pragma Convention (C, Task_Stop);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0a97caa..7699a6f 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -10050,46 +10050,34 @@ package body Sem_Ch3 is
                elsif Is_Concurrent_Record_Type (T)
                  and then Present (Interfaces (T))
                then
-                  --  If an inherited subprogram is implemented by a protected
-                  --  procedure or an entry, then the first parameter of the
-                  --  inherited subprogram shall be of mode OUT or IN OUT, or
-                  --  an access-to-variable parameter (RM 9.4(11.9/3))
-
-                  if Is_Protected_Type (Corresponding_Concurrent_Type (T))
-                    and then Ekind (First_Formal (Subp)) = E_In_Parameter
-                    and then Ekind (Subp) /= E_Function
-                    and then not Is_Predefined_Dispatching_Operation (Subp)
-                  then
-                     Error_Msg_PT (T, Subp);
-
-                  --  Some other kind of overriding failure
+                  --  There is no need to check here RM 9.4(11.9/3) since we
+                  --  are processing the corresponding record type and the
+                  --  mode of the overriding subprograms was verified by
+                  --  Check_Conformance when the corresponding concurrent
+                  --  type declaration was analyzed.
 
-                  else
-                     Error_Msg_NE
-                       ("interface subprogram & must be overridden",
-                        T, Subp);
+                  Error_Msg_NE
+                    ("interface subprogram & must be overridden", T, Subp);
 
-                     --  Examine primitive operations of synchronized type,
-                     --  to find homonyms that have the wrong profile.
+                  --  Examine primitive operations of synchronized type to find
+                  --  homonyms that have the wrong profile.
 
-                     declare
-                        Prim : Entity_Id;
+                  declare
+                     Prim : Entity_Id;
 
-                     begin
-                        Prim :=
-                          First_Entity (Corresponding_Concurrent_Type (T));
-                        while Present (Prim) loop
-                           if Chars (Prim) = Chars (Subp) then
-                              Error_Msg_NE
-                                ("profile is not type conformant with "
-                                   & "prefixed view profile of "
-                                   & "inherited operation&", Prim, Subp);
-                           end if;
+                  begin
+                     Prim := First_Entity (Corresponding_Concurrent_Type (T));
+                     while Present (Prim) loop
+                        if Chars (Prim) = Chars (Subp) then
+                           Error_Msg_NE
+                             ("profile is not type conformant with prefixed "
+                              & "view profile of inherited operation&",
+                              Prim, Subp);
+                        end if;
 
-                           Next_Entity (Prim);
-                        end loop;
-                     end;
-                  end if;
+                        Next_Entity (Prim);
+                     end loop;
+                  end;
                end if;
 
             else
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 17ad3c4..575f0b6 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.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- --
@@ -5117,7 +5117,7 @@ package body Sem_Ch6 is
                   begin
                      if Is_Protected_Type (Corresponding_Concurrent_Type (T))
                      then
-                        Error_Msg_PT (T, New_Id);
+                        Error_Msg_PT (New_Id, Ultimate_Alias (Old_Id));
                      else
                         Conformance_Error
                           ("\mode of & does not match!", New_Formal);
@@ -9364,7 +9364,7 @@ package body Sem_Ch6 is
                      or else Is_Synchronized_Interface (Iface_Typ)
                      or else Is_Task_Interface (Iface_Typ))
                then
-                  Error_Msg_PT (Parent (Typ), Candidate);
+                  Error_Msg_PT (Def_Id, Candidate);
                end if;
             end if;
 
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 1d0cfe6..355599b 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-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- --
@@ -3390,18 +3390,22 @@ package body Sem_Warn is
                Cond        : Node_Id := C;
 
             begin
-               if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not
+               if Present (Parent (C))
+                 and then Nkind (Parent (C)) = N_Op_Not
                then
                   True_Branch := not True_Branch;
-                  Cond        := Parent (C);
+                  Cond := Parent (C);
                end if;
 
+               --  Condition always True
+
                if True_Branch then
                   if Is_Entity_Name (Original_Node (C))
                     and then Nkind (Cond) /= N_Op_Not
                   then
                      Error_Msg_NE
-                       ("object & is always True?c?", Cond, Original_Node (C));
+                       ("object & is always True?c?",
+                        Cond, Original_Node (C));
                      Track (Original_Node (C), Cond);
 
                   else
@@ -3409,9 +3413,21 @@ package body Sem_Warn is
                      Track (Cond, Cond);
                   end if;
 
+               --  Condition always False
+
                else
-                  Error_Msg_N ("condition is always False?c?", Cond);
-                  Track (Cond, Cond);
+                  if Is_Entity_Name (Original_Node (C))
+                    and then Nkind (Cond) /= N_Op_Not
+                  then
+                     Error_Msg_NE
+                       ("object & is always False?c?",
+                        Cond, Original_Node (C));
+                     Track (Original_Node (C), Cond);
+
+                  else
+                     Error_Msg_N ("condition is always False?c?", Cond);
+                     Track (Cond, Cond);
+                  end if;
                end if;
             end;
          end if;