[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:
parent
08f599e80a
commit
73170f9e46
@ -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
|
||||
|
@ -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 =>
|
||||
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user