[multiple changes]

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Clarify documentation on assertions.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate, Get_Value): Warn
	if a component association has a box initialization when the
	component type has no default initialization, either through an
	initial value, an aspect, or an implicit initialization procedure.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb: Code clean up.

From-SVN: r213563
This commit is contained in:
Arnaud Charlet 2014-08-04 12:22:32 +02:00
parent 0fea901b8f
commit d10bb9d501
4 changed files with 62 additions and 14 deletions

View File

@ -1,3 +1,18 @@
2014-08-04 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Clarify documentation on assertions.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Record_Aggregate, Get_Value): Warn
if a component association has a box initialization when the
component type has no default initialization, either through an
initial value, an aspect, or an implicit initialization procedure.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* freeze.adb: Code clean up.
2014-08-04 Thomas Quinot <quinot@adacore.com>
* sem_ch5.adb: Minor reformatting.

View File

@ -4018,7 +4018,7 @@ package body Freeze is
while Present (Formal) loop
F_Type := Etype (Formal);
-- AI05-0151 : incomplete types can appear in a profile.
-- AI05-0151: incomplete types can appear in a profile.
-- By the time the entity is frozen, the full view must
-- be available, unless it is a limited view.
@ -4204,9 +4204,10 @@ package body Freeze is
Get_Source_Unit (E) /= Get_Source_Unit (N)
and then Expander_Active
and then Ekind (Scope (E)) = E_Package
and then Nkind (Unit_Declaration_Node (Scope (E)))
= N_Package_Declaration
and then not In_Open_Scopes (Scope (E));
and then Nkind (Unit_Declaration_Node (Scope (E))) =
N_Package_Declaration
and then not In_Open_Scopes (Scope (E))
and then Get_Source_Unit (E) /= Current_Sem_Unit;
-- Freeze return type

View File

@ -3604,7 +3604,10 @@ using the configuration pragma @code{Check_Policy}. In Ada 2012, it
also activates all assertions defined in the RM as aspects: preconditions,
postconditions, type invariants and (sub)type predicates. In all Ada modes,
corresponding pragmas for type invariants and (sub)type predicates are
also activated.
also activated. The default is that all these assertions are disabled,
and have no effect, other than being checked for syntactic validity, and
in the case of subtype predicates, constructions such as membership tests
still test predicates even if assertions are turned off.
@item -gnatA
@cindex @option{-gnatA} (@command{gcc})

View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
@ -3168,6 +3169,7 @@ package body Sem_Aggr is
Consider_Others_Choice : Boolean := False)
return Node_Id
is
Typ : constant Entity_Id := Etype (Compon);
Assoc : Node_Id;
Expr : Node_Id := Empty;
Selector_Name : Node_Id;
@ -3215,15 +3217,15 @@ package body Sem_Aggr is
end if;
else
if Present (Others_Etype) and then
Base_Type (Others_Etype) /= Base_Type (Etype
(Compon))
if Present (Others_Etype)
and then Base_Type (Others_Etype) /= Base_Type (Typ)
then
Error_Msg_N ("components in OTHERS choice must " &
"have same type", Selector_Name);
Error_Msg_N
("components in OTHERS choice must "
& "have same type", Selector_Name);
end if;
Others_Etype := Etype (Compon);
Others_Etype := Typ;
if Expander_Active then
return
@ -3269,15 +3271,42 @@ package body Sem_Aggr is
-- initialized, but an association for the component
-- exists, and it is not covered by an others clause.
-- Scalar and private types have no initialization
-- procedure, so they remain uninitialized. If the
-- target of the aggregate is a constant this
-- deserves a warning.
if No (Expression (Parent (Compon)))
and then not Has_Non_Null_Base_Init_Proc (Typ)
and then not Has_Aspect (Typ, Aspect_Default_Value)
and then not Is_Concurrent_Type (Typ)
and then Nkind (Parent (N)) = N_Object_Declaration
and then Constant_Present (Parent (N))
then
Error_Msg_Node_2 := Typ;
Error_Msg_NE
("component&? of type& is uninitialized",
Assoc, Selector_Name);
-- An additional reminder if the component type
-- is a generic formal.
if Is_Generic_Type (Base_Type (Typ)) then
Error_Msg_NE
("\instance should provide actual "
& "type with initialization for&",
Assoc, Typ);
end if;
end if;
return
New_Copy_Tree_And_Copy_Dimensions
(Expression (Parent (Compon)));
else
if Present (Next (Selector_Name)) then
Expr :=
New_Copy_Tree_And_Copy_Dimensions
(Expression (Assoc));
Expr := New_Copy_Tree_And_Copy_Dimensions
(Expression (Assoc));
else
Expr := Expression (Assoc);
end if;