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:
Arnaud Charlet
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>
|
||||
|
||||
* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
|
||||
|
|
|
|||
|
|
@ -8567,6 +8567,13 @@ package body Einfo is
|
|||
Subp_Id : Entity_Id;
|
||||
|
||||
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
|
||||
(Is_Type (Id)
|
||||
and then (Has_Default_Init_Cond (Id)
|
||||
|
|
|
|||
|
|
@ -6963,6 +6963,7 @@ package body Exp_Ch3 is
|
|||
or else
|
||||
Has_Inherited_Default_Init_Cond (Typ))
|
||||
and then not Has_Init_Expression (N)
|
||||
and then Present (Default_Init_Cond_Procedure (Typ))
|
||||
then
|
||||
declare
|
||||
DIC_Call : constant Node_Id :=
|
||||
|
|
|
|||
|
|
@ -317,7 +317,7 @@ procedure Gnat1drv is
|
|||
Assertions_Enabled := True;
|
||||
|
||||
-- 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
|
||||
-- very complex trees that only confuse CodePeer and do not bring
|
||||
-- enough useful info.
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- B o d y --
|
||||
-- --
|
||||
-- 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 --
|
||||
-- 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;
|
||||
|
||||
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
|
||||
or else Data (Input_Pos) /= ASCII.LF);
|
||||
|
||||
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;
|
||||
|
||||
when SEOL =>
|
||||
exit State_Machine when Input_Pos <= Data'Last;
|
||||
exit State_Machine when Input_Pos <= Last_In_Data;
|
||||
|
||||
when BOUND | NBOUND =>
|
||||
|
||||
|
|
|
|||
|
|
@ -26342,13 +26342,18 @@ package body Sem_Prag is
|
|||
-------------------------
|
||||
|
||||
function Overridden_Ancestor (S : Entity_Id) return Entity_Id is
|
||||
Par : constant Entity_Id := Find_Dispatching_Type (Inher_Id);
|
||||
Anc : Entity_Id;
|
||||
|
||||
begin
|
||||
Anc := S;
|
||||
|
||||
-- Locate the ancestor subprogram with the proper controlling
|
||||
-- type.
|
||||
|
||||
while Present (Overridden_Operation (Anc)) loop
|
||||
exit when Scope (Anc) = Scope (Inher_Id);
|
||||
Anc := Overridden_Operation (Anc);
|
||||
exit when Find_Dispatching_Type (Anc) = Par;
|
||||
end loop;
|
||||
|
||||
return Anc;
|
||||
|
|
|
|||
|
|
@ -1214,9 +1214,9 @@ package body Sem_Util is
|
|||
Prag : constant Node_Id :=
|
||||
Get_Pragma (Typ, Pragma_Default_Initial_Condition);
|
||||
Proc_Id : constant Entity_Id := Default_Init_Cond_Procedure (Typ);
|
||||
Spec_Decl : constant Node_Id := Unit_Declaration_Node (Proc_Id);
|
||||
Body_Decl : Node_Id;
|
||||
Expr : Node_Id;
|
||||
Spec_Decl : Node_Id;
|
||||
Stmt : Node_Id;
|
||||
|
||||
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 (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;
|
||||
end if;
|
||||
|
||||
|
|
@ -1293,6 +1296,7 @@ package body Sem_Util is
|
|||
-- <Stmt>;
|
||||
-- end <Typ>Default_Init_Cond;
|
||||
|
||||
Spec_Decl := Unit_Declaration_Node (Proc_Id);
|
||||
Body_Decl :=
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification =>
|
||||
|
|
@ -1378,6 +1382,17 @@ package body Sem_Util is
|
|||
|
||||
if Present (Default_Init_Cond_Procedure (Typ)) then
|
||||
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;
|
||||
|
||||
-- The related type may be subject to pragma Ghost. Set the mode now to
|
||||
|
|
|
|||
Loading…
Reference in New Issue