re PR fortran/68440 ([OOP] ICE on declaring class variable with wrong attribute)

2016-11-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/68440
	* expr.c (check_alloc_comp_init): Loosen an assert.
	* resolve.c (resolve_fl_parameter): Reject class parameters.

2016-11-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/68440
	* gfortran.dg/class_58.f90: New test.

From-SVN: r241979

gcc/fortran/ChangeLog

 2016-11-08  Janus Weil  <janus@gcc.gnu.org>
 
+	PR fortran/68440
+	* expr.c (check_alloc_comp_init): Loosen an assert.
+	* resolve.c (resolve_fl_parameter): Reject class parameters.
+
+2016-11-08  Janus Weil  <janus@gcc.gnu.org>
+
 	PR fortran/77596
 	* expr.c (gfc_check_pointer_assign): Add special check for procedure-
 	pointer component with absent interface.

gcc/fortran/expr.c

@@ -2206,7 +2206,7 @@ check_alloc_comp_init (gfc_expr *e)
   gfc_constructor *ctor;
 
   gcc_assert (e->expr_type == EXPR_STRUCTURE);
-  gcc_assert (e->ts.type == BT_DERIVED);
+  gcc_assert (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS);
 
   for (comp = e->ts.u.derived->components,
        ctor = gfc_constructor_first (e->value.constructor);

gcc/fortran/resolve.c

@@ -14001,6 +14001,15 @@ resolve_fl_parameter (gfc_symbol *sym)
 		 &sym->value->where);
       return false;
     }
+
+  /* F03:C509,C514.  */
+  if (sym->ts.type == BT_CLASS)
+    {
+      gfc_error ("CLASS variable %qs at %L cannot have the PARAMETER attribute",
+		 sym->name, &sym->declared_at);
+      return false;
+    }
+
   return true;
 }
 

gcc/testsuite/ChangeLog

+2016-11-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/68440
+	* gfortran.dg/class_58.f90: New test.
+
 2016-11-08  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/70799

gcc/testsuite/gfortran.dg/class_58.f90

+! { dg-do compile }
+!
+! PR 68440: [OOP] ICE on declaring class variable with wrong attribute
+!
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
+
+subroutine s
+  type t
+  end type
+  class(t), parameter :: x = t()  ! { dg-error "cannot have the PARAMETER attribute" }
+  class(t), parameter :: y = x    ! { dg-error "cannot have the PARAMETER attribute" }
+  class(t) :: z = x               ! { dg-error "must be dummy, allocatable or pointer" }
+end