FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sem_ch3.adb (Build_Private_Derived_Type): Set Has_Private_Ancestor on type derived from an untagged private type whose...

Browse source 
2013-01-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Private_Derived_Type): Set
	Has_Private_Ancestor on type derived from an untagged private
	type whose full view has discriminants
	* sem_aggr.adb (Resolve_Record_Aggregate): Reject non-extension
	aggregate for untagged record type with private ancestor.

From-SVN: r194892
This commit is contained in:
Ed Schonberg 2013-01-04 09:21:55 +00:00 • committed by Arnaud Charlet
parent 5ee96c9da4
commit 33bd17e742
3 changed files with 35 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/ada/ChangeLog
View file

@ -1,3 +1,11 @@
2013-01-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Private_Derived_Type): Set
Has_Private_Ancestor on type derived from an untagged private
type whose full view has discriminants
* sem_aggr.adb (Resolve_Record_Aggregate): Reject non-extension
aggregate for untagged record type with private ancestor.
2013-01-04 Thomas Quinot <quinot@adacore.com>
* sem_elab.adb, sem_ch3.adb: Minor reformatting.

19
gcc/ada/sem_aggr.adb
View file

@ -3560,7 +3560,7 @@ package body Sem_Aggr is
end if;
-- AI05-0115: if the ancestor part is a subtype mark, the ancestor
-- must npt have unknown discriminants.
-- must not have unknown discriminants.
if Is_Derived_Type (Typ)
and then Has_Unknown_Discriminants (Root_Type (Typ))
@ -3886,7 +3886,24 @@ package body Sem_Aggr is
Next_Elmt (Parent_Elmt);
end loop;
-- Typ is not a derived tagged type
else
-- A type derived from an untagged private type whose full view
-- has discriminants is constructed as a record type but there
-- are no legal aggregates for it.
if Is_Derived_Type (Typ)
and then Has_Private_Ancestor (Typ)
and then Nkind (N) /= N_Extension_Aggregate
then
Error_Msg_Node_2 := Base_Type (Etype (Typ));
Error_Msg_NE
("no aggregate available for type& derived from "
& "private type&", N, Typ);
return;
end if;
Record_Def := Type_Definition (Parent (Base_Type (Typ)));
if Null_Present (Record_Def) then

12
gcc/ada/sem_ch3.adb
View file

@ -6417,8 +6417,9 @@ package body Sem_Ch3 is
and then (In_Open_Scopes (Scope (Parent_Type)))
then
Full_Der :=
Make_Defining_Identifier
(Sloc (Derived_Type), Chars (Derived_Type));
Make_Defining_Identifier (Sloc (Derived_Type),
Chars => Chars (Derived_Type));
Set_Is_Itype (Full_Der);
Set_Has_Private_Declaration (Full_Der);
Set_Has_Private_Declaration (Derived_Type);
@ -6434,7 +6435,12 @@ package body Sem_Ch3 is
else
Build_Derived_Record_Type
(N, Full_View (Parent_Type), Derived_Type,
Derive_Subps => False);
Derive_Subps => False);
-- Except in the context of the full view of the parent, there
-- are no non-extension aggregates for the derived type.
Set_Has_Private_Ancestor (Derived_Type);
end if;
-- In any case, the primitive operations are inherited from the