[multiple changes]

2016-06-16  Gary Dismukes  <dismukes@adacore.com>

	* sem_util.adb: Minor typo fix.

2016-06-16  Emmanuel Briot  <briot@adacore.com>

	* s-regpat.adb: Further fix for invalid index in GNAT.Regexp.

2016-06-16  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch13.adb (Validate_Address_Clauses): Use the same logic to
	issue the warning on the offset for the size as for the alignment
	and tweak the wording for the sake of consistency.

2016-06-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Check_Class_Wide_COndition): New procedure,
	subsidiary of Analyze_Pre_Post_ Condition_In_Decl_Part, to
	check legality rules that follow from the revised semantics of
	class-wide pre/postconditions described in AI12-0113.
	(Build_Pragma_Check_Equivalent): Abstract subprogram declarations
	must be included in list of overriding primitives of a derived
	type.

From-SVN: r237521
This commit is contained in:
Arnaud Charlet 2016-06-16 12:39:14 +02:00
parent 08f599e80a
commit 73170f9e46
5 changed files with 122 additions and 10 deletions

View File

@ -1,3 +1,27 @@
2016-06-16 Gary Dismukes <dismukes@adacore.com>
* sem_util.adb: Minor typo fix.
2016-06-16 Emmanuel Briot <briot@adacore.com>
* s-regpat.adb: Further fix for invalid index in GNAT.Regexp.
2016-06-16 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch13.adb (Validate_Address_Clauses): Use the same logic to
issue the warning on the offset for the size as for the alignment
and tweak the wording for the sake of consistency.
2016-06-16 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Check_Class_Wide_COndition): New procedure,
subsidiary of Analyze_Pre_Post_ Condition_In_Decl_Part, to
check legality rules that follow from the revised semantics of
class-wide pre/postconditions described in AI12-0113.
(Build_Pragma_Check_Equivalent): Abstract subprogram declarations
must be included in list of overriding primitives of a derived
type.
2016-06-16 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (May_Be_Lvalue): An actual in an unexpanded

View File

@ -2614,16 +2614,28 @@ package body System.Regpat is
exit State_Machine when Input_Pos /= BOL_Pos;
when EOL =>
exit State_Machine when Input_Pos <= Last_In_Data
and then ((Self.Flags and Multiple_Lines) = 0
or else Data (Input_Pos) /= ASCII.LF);
-- A combination of MEOL and SEOL
if (Self.Flags and Multiple_Lines) = 0 then
-- single line mode
exit State_Machine when Input_Pos <= Data'Last;
elsif Input_Pos <= Last_In_Data then
exit State_Machine when Data (Input_Pos) /= ASCII.LF;
else
exit State_Machine when Last_In_Data /= Data'Last;
end if;
when MEOL =>
exit State_Machine when Input_Pos <= Last_In_Data
and then Data (Input_Pos) /= ASCII.LF;
if Input_Pos <= Last_In_Data then
exit State_Machine when Data (Input_Pos) /= ASCII.LF;
else
exit State_Machine when Last_In_Data /= Data'Last;
end if;
when SEOL =>
exit State_Machine when Input_Pos <= Last_In_Data;
-- If we have a character before Data'Last (even if
-- Last_In_Data stops before then), we can't have
-- the end of the line.
exit State_Machine when Input_Pos <= Data'Last;
when BOUND | NBOUND =>

View File

@ -13730,9 +13730,9 @@ package body Sem_Ch13 is
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
if X_Offs /= Uint_0 then
if Y_Size >= X_Size then
Error_Msg_Uint_1 := X_Offs;
Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X);
Error_Msg_NE ("\??but offset of & is ^", ACCR.N, ACCR.X);
end if;
-- Check for inadequate alignment, both of the base object

View File

@ -23279,6 +23279,74 @@ package body Sem_Prag is
Disp_Typ : Entity_Id;
Restore_Scope : Boolean := False;
function Check_References (N : Node_Id) return Traverse_Result;
-- Check that the expression does not mention non-primitives of
-- the type, global objects of the type, or other illegalities
-- described and implied by AI12-0113.
----------------------
-- Check_References --
----------------------
function Check_References (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Function_Call
and then Is_Entity_Name (Name (N))
then
declare
Func : constant Entity_Id := Entity (Name (N));
Form : Entity_Id;
begin
-- An operation of the type must be a primitive.
if No (Find_Dispatching_Type (Func)) then
Form := First_Formal (Func);
while Present (Form) loop
if Etype (Form) = Disp_Typ then
Error_Msg_NE ("operation in class-wide condition "
& "must be primitive of&", N, Disp_Typ);
end if;
Next_Formal (Form);
end loop;
-- A return object of the type is illegal as well.
if Etype (Func) = Disp_Typ
or else Etype (Func) = Class_Wide_Type (Disp_Typ)
then
Error_Msg_NE ("operation in class-wide condition "
& "must be primitive of&", N, Disp_Typ);
end if;
end if;
end;
elsif Is_Entity_Name (N)
and then
(Etype (N) = Disp_Typ
or else Etype (N) = Class_Wide_Type (Disp_Typ))
and then Ekind_In (Entity (N), E_Variable, E_Constant)
then
Error_Msg_NE
("object in class-wide condition must be formal of type&",
N, Disp_Typ);
elsif Nkind (N) = N_Explicit_Dereference
and then (Etype (N) = Disp_Typ
or else Etype (N) = Class_Wide_Type (Disp_Typ))
and then (not Is_Entity_Name (Prefix (N))
or else not Is_Formal (Entity (Prefix (N))))
then
Error_Msg_NE ("operation in class-wide condition "
& "must be primitive of&", N, Disp_Typ);
end if;
return OK;
end Check_References;
procedure Check_Class_Wide_Condition is new
Traverse_Proc (Check_References);
-- Start of processing for Analyze_Pre_Post_Condition_In_Decl_Part
begin
@ -23345,7 +23413,13 @@ package body Sem_Prag is
("pragma % can only be specified for a primitive operation "
& "of a tagged type", N);
end if;
else
-- Remaining semantic checks require a full tree traversal.
Check_Class_Wide_Condition (Expr);
end if;
end if;
if Restore_Scope then
@ -26379,7 +26453,9 @@ package body Sem_Prag is
-- overridings between them.
while Present (Decl) loop
if Nkind (Decl) = N_Subprogram_Declaration then
if Nkind_In (Decl,
N_Subprogram_Declaration, N_Abstract_Subprogram_Declaration)
then
Prim := Defining_Entity (Decl);
if Is_Subprogram (Prim)

View File

@ -1231,7 +1231,7 @@ package body Sem_Util is
pragma Assert (Has_Default_Init_Cond (Typ));
pragma Assert (Present (Prag));
-- Nothing to do if the slec was not built. This occurs when the
-- Nothing to do if the spec was not built. This occurs when the
-- expression of the Default_Initial_Condition is missing or is
-- null.