2012-06-13 Tobias Burnus <burnus@net-b.de>

        PR fortran/53643
        * trans-decl.c (init_intent_out_dt): Fix for polymorphic arrays.
        * trans-array.c (structure_alloc_comps): Don't loop for
        scalar coarrays.

2012-06-13  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53643
        * gfortran.dg/intent_out_7.f90: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ffe1254..27c0679 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,12 @@
 2012-06-13  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/53643
+       * trans-decl.c (init_intent_out_dt): Fix for polymorphic arrays.
+       * trans-array.c (structure_alloc_comps): Don't loop for
+       scalar coarrays.
+
+2012-06-13  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/53597
        * decl.c (match_attr_spec): Only mark module variables
        as SAVE_IMPLICIT for Fortran 2008 and later.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2534462..0e78210 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7318,9 +7318,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
   if ((POINTER_TYPE_P (decl_type) && rank != 0)
        || (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
-
-    decl = build_fold_indirect_ref_loc (input_location,
-                                   decl);
+    decl = build_fold_indirect_ref_loc (input_location, decl);
 
   /* Just in case in gets dereferenced.  */
   decl_type = TREE_TYPE (decl);
@@ -7328,7 +7326,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
   /* If this an array of derived types with allocatable components
      build a loop and recursively call this function.  */
   if (TREE_CODE (decl_type) == ARRAY_TYPE
-       || GFC_DESCRIPTOR_TYPE_P (decl_type))
+      || (GFC_DESCRIPTOR_TYPE_P (decl_type) && rank != 0))
     {
       tmp = gfc_conv_array_data (decl);
       var = build_fold_indirect_ref_loc (input_location,

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 637376b..75a2160 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3451,12 +3451,9 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
             && !CLASS_DATA (f->sym)->attr.class_pointer
             && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp)
       {
-       tree decl = build_fold_indirect_ref_loc (input_location,
-                                                f->sym->backend_decl);
-       tmp = CLASS_DATA (f->sym)->backend_decl;
-       tmp = fold_build3_loc (input_location, COMPONENT_REF,
-                              TREE_TYPE (tmp), decl, tmp, NULL_TREE);
-       tmp = build_fold_indirect_ref_loc (input_location, tmp);
+       tmp = gfc_class_data_get (f->sym->backend_decl);
+       if (CLASS_DATA (f->sym)->as == NULL)
+         tmp = build_fold_indirect_ref_loc (input_location, tmp);
        tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
                                         tmp,
                                         CLASS_DATA (f->sym)->as ?

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3649dcf..a8384ff 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2012-06-13  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/53643
+       * gfortran.dg/intent_out_7.f90: New.
+
+2012-06-13  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/53597
        * gfortran.dg/save_4.f90: New.
 

diff --git a/gcc/testsuite/gfortran.dg/intent_out_7.f90 b/gcc/testsuite/gfortran.dg/intent_out_7.f90
new file mode 100644 (file)
index 0000000..d75fff8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_7.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/53643
+!
+type t
+ integer, allocatable :: comp
+end type t
+contains
+ subroutine foo(x,y)
+   class(t), allocatable, intent(out) :: x(:)
+   class(t), intent(out) :: y(:)
+ end subroutine
+ subroutine foo2(x,y)
+   class(t), allocatable, intent(out) :: x
+   class(t), intent(out) :: y
+ end subroutine
+ subroutine bar(x,y)
+   class(t), intent(out) :: x(:)[*]
+   class(t), intent(out) :: y[*]
+ end subroutine
+ subroutine bar2(x,y)
+   type(t), intent(out) :: x(:)[*]
+   type(t), intent(out) :: y[*]
+ end subroutine
+end