From 1543e3abae60c26bc45fceca7b8a7f2e517a8001 Mon Sep 17 00:00:00 2001
From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 20 May 2008 14:49:21 +0200
Subject: [PATCH] re PR ada/17985 (GNAT accepts extension aggregate where
expexted type is not extension)
2008-05-20 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb: Update comments.
Improve previous change for PR ada/17985
From-SVN: r135636
---
gcc/ada/sem_aggr.adb | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 051a650f9c26..21d620716f04 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2113,7 +2113,7 @@ package body Sem_Aggr is
function Valid_Ancestor_Type return Boolean;
-- Verify that the type of the ancestor part is a non-private ancestor
- -- of the expected type.
+ -- of the expected type, which must be a type extension.
----------------------------
-- Valid_Limited_Ancestor --
@@ -2159,8 +2159,8 @@ package body Sem_Aggr is
Imm_Type := Etype (Base_Type (Imm_Type));
end loop;
- if Etype (Imm_Type) /= Base_Type (A_Type)
- or else Base_Type (Typ) = Base_Type (A_Type)
+ if not Is_Derived_Type (Base_Type (Typ))
+ or else Etype (Imm_Type) /= Base_Type (A_Type)
then
Error_Msg_NE ("expect ancestor type of &", A, Typ);
return False;