OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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 2016-06-16 12:27:34 +02:00
parent 3386e3ae5d
commit d1b83e6253
7 changed files with 65 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -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

7
gcc/ada/einfo.adb
View File

@ -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)

1
gcc/ada/exp_ch3.adb
View File

@ -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 :=

2
gcc/ada/gnat1drv.adb
View File

@ -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.

8
gcc/ada/s-regpat.adb
View File

@ -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 =>

7
gcc/ada/sem_prag.adb
View File

@ -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;

23
gcc/ada/sem_util.adb
View File

@ -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