aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch4.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2017-01-23 12:54:05 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2017-01-23 12:54:05 +0100
commitd43584ca123f03c24aa7e59a43ecf2bd3a6e4863 (patch)
tree5c7896f94b60c3c0c1fe404b8c967066aca643fe /gcc/ada/sem_ch4.adb
parent0f83b0444cf59c7d73fd870e71f6cac3c69a134e (diff)
downloadgcc-d43584ca123f03c24aa7e59a43ecf2bd3a6e4863.zip
gcc-d43584ca123f03c24aa7e59a43ecf2bd3a6e4863.tar.gz
gcc-d43584ca123f03c24aa7e59a43ecf2bd3a6e4863.tar.bz2
[multiple changes]
2017-01-23 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch5.adb, freeze.adb, par-ch4.adb, scng.adb, sem_ch13.adb, sem_ch3.adb, sem_ch5.adb, sem_ch5.ads, sem_util.adb, sinfo.ads: Minor reformatting. * exp_ch9.adb: minor style fix in comment. 2017-01-23 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Analyze_Allocator): Handle properly a type derived for a limited record extension with unknown discriminants whose full view has no discriminants. 2017-01-23 Yannick Moy <moy@adacore.com> * exp_spark.adb: Alphabetize with clauses. From-SVN: r244788
Diffstat (limited to 'gcc/ada/sem_ch4.adb')
-rw-r--r--gcc/ada/sem_ch4.adb17
1 files changed, 17 insertions, 0 deletions
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 942e21e..26d78b6 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -716,6 +716,23 @@ package body Sem_Ch4 is
then
null;
+ -- An unusual case arises when the parent of a derived type is
+ -- a limited record extension with unknown discriminants, and
+ -- its full view has no discriminants.
+ --
+ -- A more general fix might be to create the proper underlying
+ -- type for such a derived type, but it is a record type with
+ -- no private attributes, so this required extending the
+ -- meaning of this attribute. ???
+
+ elsif Ekind (Etype (Type_Id)) = E_Record_Type_With_Private
+ and then Present (Underlying_Type (Etype (Type_Id)))
+ and then
+ not Has_Discriminants (Underlying_Type (Etype (Type_Id)))
+ and then not Comes_From_Source (Parent (N))
+ then
+ null;
+
elsif Is_Class_Wide_Type (Type_Id) then
Error_Msg_N
("initialization required in class-wide allocation", N);