[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
This commit is contained in:
parent
46413d9ea9
commit
2c6336bec3
|
@ -1,3 +1,27 @@
|
|||
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):
|
||||
|
|
|
@ -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;
|
||||
|
||||
-----------------
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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).
|
||||
|
||||
|
|
|
@ -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 --
|
||||
--------------
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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))
|
||||
-- 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.
|
||||
|
||||
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);
|
||||
Error_Msg_NE
|
||||
("interface subprogram & must be overridden", T, Subp);
|
||||
|
||||
-- Some other kind of overriding failure
|
||||
-- Examine primitive operations of synchronized type to find
|
||||
-- homonyms that have the wrong profile.
|
||||
|
||||
else
|
||||
Error_Msg_NE
|
||||
("interface subprogram & must be overridden",
|
||||
T, Subp);
|
||||
declare
|
||||
Prim : Entity_Id;
|
||||
|
||||
-- Examine primitive operations of synchronized type,
|
||||
-- to find homonyms that have the wrong profile.
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
Next_Entity (Prim);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
Next_Entity (Prim);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
else
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue