re PR fortran/56500 ([OOP] "IMPLICIT CLASS(...)" wrongly rejected)

2013-04-01  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56500
	* symbol.c (gfc_set_default_type): Build class container for
	IMPLICIT CLASS.

2013-04-01  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56500
	* gfortran.dg/implicit_class_1.f90: New.

From-SVN: r197306

gcc/fortran/ChangeLog

+2013-04-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56500
+	* symbol.c (gfc_set_default_type): Build class container for
+	IMPLICIT CLASS.
+
 2013-03-31  Tobias Burnus  <burnus@net-b.de>
 
 	* class.c (finalization_scalarizer, finalizer_insert_packed_call,

gcc/fortran/symbol.c

@@ -261,6 +261,10 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
 
   if (ts->type == BT_CHARACTER && ts->u.cl)
     sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl);
+  else if (ts->type == BT_CLASS
+	   && gfc_build_class_symbol (&sym->ts, &sym->attr,
+				      &sym->as, false) == FAILURE)
+    return FAILURE;
 
   if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type)
     {

gcc/testsuite/ChangeLog

+2013-04-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56500
+	* gfortran.dg/implicit_class_1.f90: New.
+
 2013-03-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/56786

gcc/testsuite/gfortran.dg/implicit_class_1.f90

+! { dg-do run }
+!
+! PR 56500: [OOP] "IMPLICIT CLASS(...)" wrongly rejected
+!
+! Contributed by Reinhold Bader <Reinhold.Bader@lrz.de>
+
+program upimp
+  implicit class(foo) (a-b)
+  implicit class(*) (c)
+  type :: foo
+    integer :: i
+  end type
+  allocatable :: aaf, caf
+
+  allocate(aaf, source=foo(2))
+  select type (aaf)
+  type is (foo)
+    if (aaf%i /= 2) call abort
+  class default
+    call abort
+  end select
+
+  allocate(caf, source=foo(3))
+  select type (caf)
+  type is (foo)
+    if (caf%i /= 3) call abort
+  class default
+    call abort
+  end select
+
+contains
+  subroutine gloo(x)
+    implicit class(*) (a-z)
+  end
+end program