re PR fortran/45507 (Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4))

2010-09-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45507
	* resolve.c (resolve_allocate_expr): Generate default initializers
	already at this point, resolve them and put them into expr3, ...
	* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
	translation stage.

2010-09-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45507
	* gfortran.dg/allocate_alloc_opt_12.f90: New.

From-SVN: r163856

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 517ca84..428cd3f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2010-09-04  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45507
+       * resolve.c (resolve_allocate_expr): Generate default initializers
+       already at this point, resolve them and put them into expr3, ...
+       * trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
+       translation stage.
+
 2010-09-03  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/45186

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 88f43cd..9099ada 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6714,6 +6714,34 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       goto failure;
     }
 
+  if (!code->expr3)
+    {
+      /* Set up default initializer if needed.  */
+      gfc_typespec ts;
+
+      if (code->ext.alloc.ts.type == BT_DERIVED)
+       ts = code->ext.alloc.ts;
+      else
+       ts = e->ts;
+
+      if (ts.type == BT_CLASS)
+       ts = ts.u.derived->components->ts;
+
+      if (ts.type == BT_DERIVED)
+       {
+         code->expr3 = gfc_default_initializer (&ts);
+         gfc_resolve_expr (code->expr3);
+       }
+    }
+  else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
+    {
+      /* Default initialization via MOLD (non-polymorphic).  */
+      gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+      gfc_resolve_expr (rhs);
+      gfc_free_expr (code->expr3);
+      code->expr3 = rhs;
+    }
+
   if (e->ts.type == BT_CLASS)
     {
       /* Make sure the vtab symbol is present when

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 29b3322..dda38b6 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4475,9 +4475,10 @@ gfc_trans_allocate (gfc_code * code)
       tmp = gfc_finish_block (&se.pre);
       gfc_add_expr_to_block (&block, tmp);
 
-      /* Initialization via SOURCE block.  */
       if (code->expr3 && !code->expr3->mold)
        {
+         /* Initialization via SOURCE block
+            (or static default initializer).  */
          gfc_expr *rhs = gfc_copy_expr (code->expr3);
          if (al->expr->ts.type == BT_CLASS)
            {
@@ -4497,53 +4498,22 @@ gfc_trans_allocate (gfc_code * code)
          gfc_free_expr (rhs);
          gfc_add_expr_to_block (&block, tmp);
        }
-      else
+      else if (code->expr3 && code->expr3->mold
+           && code->expr3->ts.type == BT_CLASS)
        {
-         /* Add default initializer for those derived types that need them.  */
-         gfc_expr *rhs = NULL;
-         gfc_typespec ts;
-
-         if (code->ext.alloc.ts.type == BT_DERIVED)
-           ts = code->ext.alloc.ts;
-         else if (code->expr3)
-           ts = code->expr3->ts;
-         else
-           ts = expr->ts;
-
-         if (ts.type == BT_DERIVED)
-           {
-             rhs = gfc_default_initializer (&ts);
-             gfc_resolve_expr (rhs);
-           }
-         else if (ts.type == BT_CLASS)
-           {
-             rhs = gfc_copy_expr (code->expr3);
-             gfc_add_component_ref (rhs, "$vptr");
-             gfc_add_component_ref (rhs, "$def_init");
-           }
-
-         if (rhs)
-           {
-             gfc_expr *lhs = gfc_expr_to_initialize (expr);
-             if (al->expr->ts.type == BT_DERIVED)
-               {
-                 tmp = gfc_trans_assignment (lhs, rhs, true, false);
-                 gfc_add_expr_to_block (&block, tmp);
-               }
-             else if (al->expr->ts.type == BT_CLASS)
-               {
-                 gfc_se dst,src;
-                 gfc_init_se (&dst, NULL);
-                 gfc_init_se (&src, NULL);
-                 gfc_conv_expr (&dst, lhs);
-                 gfc_conv_expr (&src, rhs);
-                 gfc_add_block_to_block (&block, &src.pre);
-                 tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
-                 gfc_add_expr_to_block (&block, tmp);
-               }
-             gfc_free_expr (lhs);
-             gfc_free_expr (rhs);
-           }
+         /* Default-initialization via MOLD (polymorphic).  */
+         gfc_expr *rhs = gfc_copy_expr (code->expr3);
+         gfc_se dst,src;
+         gfc_add_component_ref (rhs, "$vptr");
+         gfc_add_component_ref (rhs, "$def_init");
+         gfc_init_se (&dst, NULL);
+         gfc_init_se (&src, NULL);
+         gfc_conv_expr (&dst, expr);
+         gfc_conv_expr (&src, rhs);
+         gfc_add_block_to_block (&block, &src.pre);
+         tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
+         gfc_add_expr_to_block (&block, tmp);
+         gfc_free_expr (rhs);
        }
 
       /* Allocation of CLASS entities.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9834ddd..52dd4e8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-04  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45507
+       * gfortran.dg/allocate_alloc_opt_12.f90: New.
+
 2010-09-03  Joseph Myers  <joseph@codesourcery.com>
 
        * gcc.dg/opts-4.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
new file mode 100644 (file)
index 0000000..2af0692
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR 45507: [4.6 Regression] Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4)
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+ use, intrinsic :: iso_c_binding
+
+ type :: cType
+   type(c_ptr) :: accelPtr = c_null_ptr
+ end type cType
+
+ type(cType), allocatable, dimension(:) :: filters
+ class(cType), allocatable :: f
+
+ allocate(filters(1))
+ allocate(f,MOLD=filters(1))
+
+end