[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:
Arnaud Charlet 2015-01-30 16:06:14 +01:00
parent 46413d9ea9
commit 2c6336bec3
9 changed files with 99 additions and 59 deletions

View File

@ -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):

View File

@ -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;
-----------------

View File

@ -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

View File

@ -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).

View File

@ -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 --
--------------

View File

@ -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);

View File

@ -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

View File

@ -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;

View File

@ -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;