OSDN Git Service

2010-10-26 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 26 Oct 2010 06:49:43 +0000 (06:49 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 26 Oct 2010 06:49:43 +0000 (06:49 +0000)
        PR fortran/45451
        * trans-stmt.c (gfc_trans_allocate): Do a deep-copy for SOURCE=.

        PR fortran/43018
        * trans-array.c (duplicate_allocatable): Use size of type and not
        the size of the pointer to the type.

2010-10-26  Tobias Burnus <burnus@net-b.de>

        PR fortran/45451
        * gfortran.dg/class_allocate_5.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165936 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-stmt.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/class_allocate_5.f90 [new file with mode: 0644]

index 006ea6e..73eb4ad 100644 (file)
@@ -1,3 +1,12 @@
+2010-10-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45451
+       * trans-stmt.c (gfc_trans_allocate): Do a deep-copy for SOURCE=.
+
+       PR fortran/43018
+       * trans-array.c (duplicate_allocatable): Use size of type and not
+       the size of the pointer to the type.
+
 2010-10-25  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/46140
index 52ba831..db05734 100644 (file)
@@ -6072,7 +6072,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
-      size = TYPE_SIZE_UNIT (type);
+      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
       if (!no_malloc)
        {
          tmp = gfc_call_malloc (&block, type, size);
index 6e1a20b..d079230 100644 (file)
@@ -4487,8 +4487,12 @@ gfc_trans_allocate (gfc_code * code)
          /* Initialization via SOURCE block
             (or static default initializer).  */
          gfc_expr *rhs = gfc_copy_expr (code->expr3);
-         if (al->expr->ts.type == BT_CLASS)
+         if (al->expr->ts.type == BT_CLASS && rhs->expr_type == EXPR_VARIABLE
+             && rhs->ts.type != BT_CLASS)
+           tmp = gfc_trans_assignment (expr, rhs, false, false);
+         else if (al->expr->ts.type == BT_CLASS)
            {
+             /* TODO: One needs to do a deep-copy for BT_CLASS; cf. PR 46174.  */
              gfc_se dst,src;
              if (rhs->ts.type == BT_CLASS)
                gfc_add_component_ref (rhs, "$data");
index 429ab84..5eb2f5c 100644 (file)
@@ -1,3 +1,8 @@
+2010-10-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45451
+       * gfortran.dg/class_allocate_5.f90: New.
+
 2010-10-25  Rodrigo Rivas Costa <rodrigorivascosta@gmail.com>
 
        Implement opaque-enum-specifiers for C++0x
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_5.f90 b/gcc/testsuite/gfortran.dg/class_allocate_5.f90
new file mode 100644 (file)
index 0000000..592161e
--- /dev/null
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR fortran/45451
+!
+! Contributed by Salvatore Filippone and Janus Weil
+!
+! Check that ALLOCATE with SOURCE= does a deep copy.
+!
+program bug23
+  implicit none
+
+  type  :: psb_base_sparse_mat
+    integer, allocatable :: irp(:)
+  end type psb_base_sparse_mat
+
+  class(psb_base_sparse_mat), allocatable  :: a 
+  type(psb_base_sparse_mat) :: acsr
+
+  allocate(acsr%irp(4)) 
+  acsr%irp(1:4) = (/1,3,4,5/)
+
+  write(*,*) acsr%irp(:)
+
+  allocate(a,source=acsr)
+
+  write(*,*) a%irp(:)
+
+  call move_alloc(acsr%irp, a%irp)
+
+  write(*,*) a%irp(:)
+
+  if (any (a%irp /= [1,3,4,5])) call abort()
+end program bug23
+