From: Arnaud Charlet Date: Fri, 30 Jan 2015 15:06:14 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2c6336bec3f0a2db44fa56e7448aaf119aa6665c;p=gcc.git [multiple changes] 2015-01-30 Gary Dismukes * freeze.adb: Minor reformatting. 2015-01-30 Javier Miranda * 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 * sem_warn.adb (Warn_On_Known_Condition): Do special casing of message for False case. 2015-01-30 Doug Rupp * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 593ea391f60..6a0dbd26f71 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2015-01-30 Gary Dismukes + + * freeze.adb: Minor reformatting. + +2015-01-30 Javier Miranda + + * 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 + + * sem_warn.adb (Warn_On_Known_Condition): Do special casing of + message for False case. + +2015-01-30 Doug Rupp + + * 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 * sem_attr.adb (Declared_Within_Generic_Unit): diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 803e2d4c939..d04d132636e 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 6ca45497fde..610588048d0 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 12154a0e75a..3c88297aae9 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 584de4f7323..404e9aaa946 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- -- @@ -85,6 +85,17 @@ package body System.VxWorks.Ext is return ERROR; 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 c8cba655cec..dfdbcf19544 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 0a97caaf999..7699a6fc80f 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 17ad3c408e8..575f0b68039 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 1d0cfe6d325..355599b0957 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;