+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
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)
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 :=
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.
-- 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- --
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 =>
-------------------------
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;
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;
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;
-- <Stmt>;
-- end <Typ>Default_Init_Cond;
+ Spec_Decl := Unit_Declaration_Node (Proc_Id);
Body_Decl :=
Make_Subprogram_Body (Loc,
Specification =>
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
projects / gcc.git / commitdiff