mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2016-06-16 Ed Schonberg <schonberg@adacore.com> * sem_prag.adb (Overridden_Ancestor): Clean up code to use controlling type of desired primitive rather than its scope, because the primitive that inherits the classwide condition may comes from several derivation steps. 2016-06-16 Javier Miranda <miranda@adacore.com> * einfo.adb (Set_Default_Init_Cond_Procedure): Allow calls setting this attribute to Empty (only if the attribute has not been set). * sem_util.adb (Build_Default_Init_Cond_Procedure_Body): No action needed if the spec was not built. (Build_Default_Init_Cond_Procedure_Declaration): The spec is not built if DIC is set to NULL or no condition was specified. * exp_ch3.adb (Expand_N_Object_Declaration): Check availability of the Init_Cond procedure before generating code to call it. 2016-06-16 Emmanuel Briot <briot@adacore.com> * s-regpat.adb: Fix invalid index check when matching end-of-line on substrings. 2016-06-16 Arnaud Charlet <charlet@adacore.com> * gnat1drv.adb: Minor reformatting. From-SVN: r237516
This commit is contained in:
parent
3386e3ae5d
commit
d1b83e6253
|
|
@ -1,3 +1,30 @@
|
||||||
|
2016-06-16 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_prag.adb (Overridden_Ancestor): Clean up code to use
|
||||||
|
controlling type of desired primitive rather than its scope,
|
||||||
|
because the primitive that inherits the classwide condition may
|
||||||
|
comes from several derivation steps.
|
||||||
|
|
||||||
|
2016-06-16 Javier Miranda <miranda@adacore.com>
|
||||||
|
|
||||||
|
* einfo.adb (Set_Default_Init_Cond_Procedure): Allow calls setting
|
||||||
|
this attribute to Empty (only if the attribute has not been set).
|
||||||
|
* sem_util.adb (Build_Default_Init_Cond_Procedure_Body):
|
||||||
|
No action needed if the spec was not built.
|
||||||
|
(Build_Default_Init_Cond_Procedure_Declaration): The spec is
|
||||||
|
not built if DIC is set to NULL or no condition was specified.
|
||||||
|
* exp_ch3.adb (Expand_N_Object_Declaration): Check availability
|
||||||
|
of the Init_Cond procedure before generating code to call it.
|
||||||
|
|
||||||
|
2016-06-16 Emmanuel Briot <briot@adacore.com>
|
||||||
|
|
||||||
|
* s-regpat.adb: Fix invalid index check when matching end-of-line
|
||||||
|
on substrings.
|
||||||
|
|
||||||
|
2016-06-16 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
|
* gnat1drv.adb: Minor reformatting.
|
||||||
|
|
||||||
2016-06-16 Ed Schonberg <schonberg@adacore.com>
|
2016-06-16 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
|
* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
|
||||||
|
|
|
||||||
|
|
@ -8567,6 +8567,13 @@ package body Einfo is
|
||||||
Subp_Id : Entity_Id;
|
Subp_Id : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
-- Once set this attribute it cannot be reset
|
||||||
|
|
||||||
|
if No (V) then
|
||||||
|
pragma Assert (No (Default_Init_Cond_Procedure (Id)));
|
||||||
|
return;
|
||||||
|
end if;
|
||||||
|
|
||||||
pragma Assert
|
pragma Assert
|
||||||
(Is_Type (Id)
|
(Is_Type (Id)
|
||||||
and then (Has_Default_Init_Cond (Id)
|
and then (Has_Default_Init_Cond (Id)
|
||||||
|
|
|
||||||
|
|
@ -6963,6 +6963,7 @@ package body Exp_Ch3 is
|
||||||
or else
|
or else
|
||||||
Has_Inherited_Default_Init_Cond (Typ))
|
Has_Inherited_Default_Init_Cond (Typ))
|
||||||
and then not Has_Init_Expression (N)
|
and then not Has_Init_Expression (N)
|
||||||
|
and then Present (Default_Init_Cond_Procedure (Typ))
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
DIC_Call : constant Node_Id :=
|
DIC_Call : constant Node_Id :=
|
||||||
|
|
|
||||||
|
|
@ -317,7 +317,7 @@ procedure Gnat1drv is
|
||||||
Assertions_Enabled := True;
|
Assertions_Enabled := True;
|
||||||
|
|
||||||
-- Set normal RM validity checking and checking of copies (to catch
|
-- Set normal RM validity checking and checking of copies (to catch
|
||||||
-- e.g. wrong values used in unchecked conversions).
|
-- e.g. wrong values used in unchecked conversions).
|
||||||
-- All other validity checking is turned off, since this can generate
|
-- All other validity checking is turned off, since this can generate
|
||||||
-- very complex trees that only confuse CodePeer and do not bring
|
-- very complex trees that only confuse CodePeer and do not bring
|
||||||
-- enough useful info.
|
-- enough useful info.
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,7 @@
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1986 by University of Toronto. --
|
-- Copyright (C) 1986 by University of Toronto. --
|
||||||
-- Copyright (C) 1999-2015, AdaCore --
|
-- Copyright (C) 1999-2016, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
|
@ -2614,16 +2614,16 @@ package body System.Regpat is
|
||||||
exit State_Machine when Input_Pos /= BOL_Pos;
|
exit State_Machine when Input_Pos /= BOL_Pos;
|
||||||
|
|
||||||
when EOL =>
|
when EOL =>
|
||||||
exit State_Machine when Input_Pos <= Data'Last
|
exit State_Machine when Input_Pos <= Last_In_Data
|
||||||
and then ((Self.Flags and Multiple_Lines) = 0
|
and then ((Self.Flags and Multiple_Lines) = 0
|
||||||
or else Data (Input_Pos) /= ASCII.LF);
|
or else Data (Input_Pos) /= ASCII.LF);
|
||||||
|
|
||||||
when MEOL =>
|
when MEOL =>
|
||||||
exit State_Machine when Input_Pos <= Data'Last
|
exit State_Machine when Input_Pos <= Last_In_Data
|
||||||
and then Data (Input_Pos) /= ASCII.LF;
|
and then Data (Input_Pos) /= ASCII.LF;
|
||||||
|
|
||||||
when SEOL =>
|
when SEOL =>
|
||||||
exit State_Machine when Input_Pos <= Data'Last;
|
exit State_Machine when Input_Pos <= Last_In_Data;
|
||||||
|
|
||||||
when BOUND | NBOUND =>
|
when BOUND | NBOUND =>
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -26342,13 +26342,18 @@ package body Sem_Prag is
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|
||||||
function Overridden_Ancestor (S : Entity_Id) return Entity_Id is
|
function Overridden_Ancestor (S : Entity_Id) return Entity_Id is
|
||||||
|
Par : constant Entity_Id := Find_Dispatching_Type (Inher_Id);
|
||||||
Anc : Entity_Id;
|
Anc : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Anc := S;
|
Anc := S;
|
||||||
|
|
||||||
|
-- Locate the ancestor subprogram with the proper controlling
|
||||||
|
-- type.
|
||||||
|
|
||||||
while Present (Overridden_Operation (Anc)) loop
|
while Present (Overridden_Operation (Anc)) loop
|
||||||
exit when Scope (Anc) = Scope (Inher_Id);
|
|
||||||
Anc := Overridden_Operation (Anc);
|
Anc := Overridden_Operation (Anc);
|
||||||
|
exit when Find_Dispatching_Type (Anc) = Par;
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
return Anc;
|
return Anc;
|
||||||
|
|
|
||||||
|
|
@ -1214,9 +1214,9 @@ package body Sem_Util is
|
||||||
Prag : constant Node_Id :=
|
Prag : constant Node_Id :=
|
||||||
Get_Pragma (Typ, Pragma_Default_Initial_Condition);
|
Get_Pragma (Typ, Pragma_Default_Initial_Condition);
|
||||||
Proc_Id : constant Entity_Id := Default_Init_Cond_Procedure (Typ);
|
Proc_Id : constant Entity_Id := Default_Init_Cond_Procedure (Typ);
|
||||||
Spec_Decl : constant Node_Id := Unit_Declaration_Node (Proc_Id);
|
|
||||||
Body_Decl : Node_Id;
|
Body_Decl : Node_Id;
|
||||||
Expr : Node_Id;
|
Expr : Node_Id;
|
||||||
|
Spec_Decl : Node_Id;
|
||||||
Stmt : Node_Id;
|
Stmt : Node_Id;
|
||||||
|
|
||||||
Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
|
Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
|
||||||
|
|
@ -1230,11 +1230,14 @@ package body Sem_Util is
|
||||||
|
|
||||||
pragma Assert (Has_Default_Init_Cond (Typ));
|
pragma Assert (Has_Default_Init_Cond (Typ));
|
||||||
pragma Assert (Present (Prag));
|
pragma Assert (Present (Prag));
|
||||||
pragma Assert (Present (Proc_Id));
|
|
||||||
|
|
||||||
-- Nothing to do if the body was already built
|
-- No action needed if the spec was not built or if the body was
|
||||||
|
-- already built.
|
||||||
|
|
||||||
if Present (Corresponding_Body (Spec_Decl)) then
|
if No (Proc_Id)
|
||||||
|
or else
|
||||||
|
Present (Corresponding_Body (Unit_Declaration_Node (Proc_Id)))
|
||||||
|
then
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
@ -1293,6 +1296,7 @@ package body Sem_Util is
|
||||||
-- <Stmt>;
|
-- <Stmt>;
|
||||||
-- end <Typ>Default_Init_Cond;
|
-- end <Typ>Default_Init_Cond;
|
||||||
|
|
||||||
|
Spec_Decl := Unit_Declaration_Node (Proc_Id);
|
||||||
Body_Decl :=
|
Body_Decl :=
|
||||||
Make_Subprogram_Body (Loc,
|
Make_Subprogram_Body (Loc,
|
||||||
Specification =>
|
Specification =>
|
||||||
|
|
@ -1378,6 +1382,17 @@ package body Sem_Util is
|
||||||
|
|
||||||
if Present (Default_Init_Cond_Procedure (Typ)) then
|
if Present (Default_Init_Cond_Procedure (Typ)) then
|
||||||
return;
|
return;
|
||||||
|
|
||||||
|
-- The procedure must not be generated when DIC has one of these two
|
||||||
|
-- forms: 1. Default_Initial_Condition => null
|
||||||
|
-- 2. Default_Initial_Condition
|
||||||
|
|
||||||
|
elsif No (Pragma_Argument_Associations (Prag))
|
||||||
|
or else
|
||||||
|
Nkind (Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag))))
|
||||||
|
= N_Null
|
||||||
|
then
|
||||||
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- The related type may be subject to pragma Ghost. Set the mode now to
|
-- The related type may be subject to pragma Ghost. Set the mode now to
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue