[multiple changes]

2015-01-07  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Conversion): Adding missing
	generation of accessibility check.

2015-01-07  Ed Schonberg  <schonberg@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 25920e3..b45007b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2015-01-07  Javier Miranda  <miranda@adacore.com>
+
+       * exp_disp.adb (Expand_Interface_Conversion): Adding missing
+       generation of accessibility check.
+
+2015-01-07  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <dewar@adacore.com>
 
        * 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 3f99964..4d07a37 100644 (file)
--- 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 61be2f9..7757d6d 100644 (file)
--- 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;