From 2ea3ba25c015d93f76b26ef1a3cf7497e8006b7c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 7 Jan 2015 09:52:35 +0100 Subject: [PATCH] [multiple changes] 2015-01-07 Javier Miranda * exp_disp.adb (Expand_Interface_Conversion): Adding missing generation of accessibility check. 2015-01-07 Ed Schonberg * sem_ch3.adb (Derived_Type_Declaration): In the case of an illegal completion from a class- wide type, set etype of the derived type properly to prevent cascaded errors. From-SVN: r219283 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_disp.adb | 5 +++++ gcc/ada/sem_ch3.adb | 5 +++-- 3 files changed, 19 insertions(+), 2 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 25920e38cd1..b45007bd6f8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2015-01-07 Javier Miranda + + * exp_disp.adb (Expand_Interface_Conversion): Adding missing + generation of accessibility check. + +2015-01-07 Ed Schonberg + + * sem_ch3.adb (Derived_Type_Declaration): In the case of an + illegal completion from a class- wide type, set etype of the + derived type properly to prevent cascaded errors. + 2015-01-07 Robert Dewar * prj.ads, i-cpoint.adb, freeze.adb, ghost.adb, prj-err.adb: Minor diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 3f999647413..4d07a3752bf 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1422,6 +1422,11 @@ package body Exp_Disp is if Is_Access_Type (Etype (Expression (N))) then + Apply_Accessibility_Check + (N => Expression (N), + Typ => Etype (N), + Insert_Node => N); + -- Generate: Func (Address!(Expression)) Rewrite (N, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 61be2f9b602..7757d6dda86 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15860,11 +15860,12 @@ package body Sem_Ch3 is Taggd := Is_Tagged_Type (Parent_Type); - -- Perhaps the parent type should be changed to the class-wide type's - -- specific type in this case to prevent cascading errors ??? + -- Set the parent type to the class-wide type's specific type + -- in this case to prevent cascading errors if Present (Extension) and then Is_Class_Wide_Type (Parent_Type) then Error_Msg_N ("parent type must not be a class-wide type", Indic); + Set_Etype (T, Etype (Parent_Type)); return; end if; -- 2.30.2