Revert "Prevent malicious descriptor stacking for scalar components."

Breaks bootstrap.

This reverts commit c9c48ab7bad9fe5e096076e56a60ce0a5a2b65f7.

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1234932..2f0c8a4 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9102,10 +9102,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
                continue;
            }
 
-         /* Do not broadcast a caf_token.  These are local to the image.  */
-         if (attr->caf_token)
-           continue;
-
          add_when_allocated = NULL_TREE;
          if (cmp_has_alloc_comps
              && !c->attr.pointer && !c->attr.proc_pointer)
@@ -9138,13 +9134,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
          if (attr->dimension)
            {
              tmp = gfc_get_element_type (TREE_TYPE (comp));
-             if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
-               ubound = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (comp));
-             else
-               ubound = gfc_full_array_size (&tmpblock, comp,
-                                             c->ts.type == BT_CLASS
-                                             ? CLASS_DATA (c)->as->rank
-                                             : c->as->rank);
+             ubound = gfc_full_array_size (&tmpblock, comp,
+                                           c->ts.type == BT_CLASS
+                                           ? CLASS_DATA (c)->as->rank
+                                           : c->as->rank);
            }
          else
            {
@@ -9152,36 +9145,26 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              ubound = build_int_cst (gfc_array_index_type, 1);
            }
 
-         /* Treat strings like arrays.  Or the other way around, do not
-          * generate an additional array layer for scalar components.  */
-         if (attr->dimension || c->ts.type == BT_CHARACTER)
-           {
-             cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
-                                                &ubound, 1,
-                                                GFC_ARRAY_ALLOCATABLE, false);
+         cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+                                            &ubound, 1,
+                                            GFC_ARRAY_ALLOCATABLE, false);
 
-             cdesc = gfc_create_var (cdesc, "cdesc");
-             DECL_ARTIFICIAL (cdesc) = 1;
+         cdesc = gfc_create_var (cdesc, "cdesc");
+         DECL_ARTIFICIAL (cdesc) = 1;
 
-             gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc),
-                             gfc_get_dtype_rank_type (1, tmp));
-             gfc_conv_descriptor_lbound_set (&tmpblock, cdesc,
-                                             gfc_index_zero_node,
-                                             gfc_index_one_node);
-             gfc_conv_descriptor_stride_set (&tmpblock, cdesc,
-                                             gfc_index_zero_node,
-                                             gfc_index_one_node);
-             gfc_conv_descriptor_ubound_set (&tmpblock, cdesc,
-                                             gfc_index_zero_node, ubound);
-           }
+         gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc),
+                         gfc_get_dtype_rank_type (1, tmp));
+         gfc_conv_descriptor_lbound_set (&tmpblock, cdesc,
+                                         gfc_index_zero_node,
+                                         gfc_index_one_node);
+         gfc_conv_descriptor_stride_set (&tmpblock, cdesc,
+                                         gfc_index_zero_node,
+                                         gfc_index_one_node);
+         gfc_conv_descriptor_ubound_set (&tmpblock, cdesc,
+                                         gfc_index_zero_node, ubound);
 
          if (attr->dimension)
-           {
-             if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
-               comp = gfc_conv_descriptor_data_get (comp);
-             else
-               comp = gfc_build_addr_expr (NULL_TREE, comp);
-           }
+           comp = gfc_conv_descriptor_data_get (comp);
          else
            {
              gfc_se se;
@@ -9189,18 +9172,14 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              gfc_init_se (&se, NULL);
 
              comp = gfc_conv_scalar_to_descriptor (&se, comp,
-                                                    c->ts.type == BT_CLASS
-                                                    ? CLASS_DATA (c)->attr
-                                                    : c->attr);
-             if (c->ts.type == BT_CHARACTER)
-               comp = gfc_build_addr_expr (NULL_TREE, comp);
+                                                   c->ts.type == BT_CLASS
+                                                   ? CLASS_DATA (c)->attr
+                                                   : c->attr);
+             comp = gfc_build_addr_expr (NULL_TREE, comp);
              gfc_add_block_to_block (&tmpblock, &se.pre);
            }
 
-         if (attr->dimension || c->ts.type == BT_CHARACTER)
-           gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
-         else
-           cdesc = comp;
+         gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
 
          tree fndecl;
 

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index e680de1..da854fa 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11212,31 +11212,24 @@ conv_co_collective (gfc_code *code)
       return gfc_finish_block (&block);
     }
 
-  gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED
-    ? code->ext.actual->expr->ts.u.derived : NULL;
-
   /* Handle the array.  */
   gfc_init_se (&argse, NULL);
-  if (!derived || !derived->attr.alloc_comp
-      || code->resolved_isym->id != GFC_ISYM_CO_BROADCAST)
+  if (code->ext.actual->expr->rank == 0)
     {
-      if (code->ext.actual->expr->rank == 0)
-       {
-         symbol_attribute attr;
-         gfc_clear_attr (&attr);
-         gfc_init_se (&argse, NULL);
-         gfc_conv_expr (&argse, code->ext.actual->expr);
-         gfc_add_block_to_block (&block, &argse.pre);
-         gfc_add_block_to_block (&post_block, &argse.post);
-         array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr);
-         array = gfc_build_addr_expr (NULL_TREE, array);
-       }
-      else
-       {
-         argse.want_pointer = 1;
-         gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
-         array = argse.expr;
-       }
+      symbol_attribute attr;
+      gfc_clear_attr (&attr);
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, code->ext.actual->expr);
+      gfc_add_block_to_block (&block, &argse.pre);
+      gfc_add_block_to_block (&post_block, &argse.post);
+      array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr);
+      array = gfc_build_addr_expr (NULL_TREE, array);
+    }
+  else
+    {
+      argse.want_pointer = 1;
+      gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
+      array = argse.expr;
     }
 
   gfc_add_block_to_block (&block, &argse.pre);
@@ -11297,6 +11290,9 @@ conv_co_collective (gfc_code *code)
       gcc_unreachable ();
     }
 
+  gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED
+    ? code->ext.actual->expr->ts.u.derived : NULL;
+
   if (derived && derived->attr.alloc_comp
       && code->resolved_isym->id == GFC_ISYM_CO_BROADCAST)
     /* The derived type has the attribute 'alloc_comp'.  */

diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
deleted file mode 100644 (file)
index c83899d..0000000
--- a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
+++ /dev/null
@@ -1,37 +0,0 @@
-! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original -fcoarray=lib" }
-!
-! PR 103970
-! Test case inspired by code submitted by Damian Rousson
-
-program main
-
-  implicit none
-
-  type foo_t
-    integer i
-    integer, allocatable :: j
-  end type
-
-  type(foo_t) foo
-  integer, parameter :: source_image = 1
-
-  if (this_image() == source_image)  then
-    foo = foo_t(2,3)
-  else
-    allocate(foo%j)
-  end if
-  call co_broadcast(foo, source_image)
-
-  if ((foo%i /= 2) .or. (foo%j /= 3))  error stop 1
-  sync all
-
-end program
-
-! Wrong code generation produced too many temp descriptors
-! leading to stacked descriptors handed to the co_broadcast.
-! This lead to access to non exsitant memory in opencoarrays.
-! In single image mode just checking for reduced number of
-! descriptors is possible, i.e., execute always works.
-! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 12 "original" } }
-