re PR fortran/48699 ([OOP] MOVE_ALLOC inside SELECT TYPE)
authorJanus Weil <janus@gcc.gnu.org>
Fri, 17 Jun 2011 20:03:04 +0000 (22:03 +0200)
committerJanus Weil <janus@gcc.gnu.org>
Fri, 17 Jun 2011 20:03:04 +0000 (22:03 +0200)
2011-06-17  Janus Weil  <janus@gcc.gnu.org>

PR fortran/48699
* check.c (gfc_check_move_alloc): If 'TO' argument is polymorphic,
make sure the vtab is present.

2011-06-17  Janus Weil  <janus@gcc.gnu.org>

PR fortran/48699
* gfortran.dg/move_alloc_5.f90: New.

From-SVN: r175151

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/move_alloc_5.f90 [new file with mode: 0644]

index e0428211dd7f23446001ce62fffd586e359f1d64..d7c598194301f275c3c9e6de2ff7dfe23c86a6ce 100644 (file)
@@ -1,3 +1,9 @@
+2011-06-17  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/48699
+       * check.c (gfc_check_move_alloc): If 'TO' argument is polymorphic,
+       make sure the vtab is present.
+
 2011-06-16  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/49074
index 117896731150155107bfec4bc0e57360d49c4ce4..972b290c987d84b9bc284c28ad421569da057475 100644 (file)
@@ -2672,6 +2672,10 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
       return FAILURE;
     }
 
+  /* CLASS arguments: Make sure the vtab is present.  */
+  if (to->ts.type == BT_CLASS)
+    gfc_find_derived_vtab (from->ts.u.derived);
+
   return SUCCESS;
 }
 
index 8fe2a0374bd0d729e9c9b7c1fd640f2391b04d93..1adce47c6215a26686526f650790b9b9cf2a8883 100644 (file)
@@ -1,3 +1,8 @@
+2011-06-17  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/48699
+       * gfortran.dg/move_alloc_5.f90: New.
+
 2011-06-17  Hans-Peter Nilsson  <hp@axis.com>
 
        PR rtl-optimization/48542
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_5.f90 b/gcc/testsuite/gfortran.dg/move_alloc_5.f90
new file mode 100644 (file)
index 0000000..b2759de
--- /dev/null
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR 48699: [4.6/4.7 Regression] [OOP] MOVE_ALLOC inside SELECT TYPE
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+program testmv1
+
+  type bar
+  end type
+
+  type, extends(bar) ::  bar2
+  end type
+
+  class(bar), allocatable :: sm
+  type(bar2), allocatable :: sm2
+
+  allocate (sm2)
+  call move_alloc (sm2,sm)
+
+  if (allocated(sm2)) call abort()
+  if (.not. allocated(sm)) call abort()
+
+end program