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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 92a5f00c0a29597fc765393a68f6ccce63f547e7..7f9a1a5ccb3d2f695f46f0c2e513aa9315c3c68e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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,

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ec64231da8fdc51a3428cdf15e0855ee150e36dd..6fc5812b218cbf52995e8aa9a637562f12a5653c 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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)
     {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 48bebd0fe5e50cfa3cb8495f77bb64351846f028..c1fc14d4bb435bd716990b93850da4b0e77928af 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90
new file mode 100644 (file)
index 0000000..329f57a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_class_1.f90
@@ -0,0 +1,35 @@
+! { 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