+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):
-- --
-- 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- --
-- 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;
-----------------
-- --
-- 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- --
-- 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
-- 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).
-- --
-- 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- --
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 --
--------------
-- --
-- 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- --
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);
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
-- --
-- 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- --
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);
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;
-- --
-- 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- --
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
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;
projects / gcc.git / commitdiff