[gcc r12-6911] Revert "Prevent malicious descriptor stacking for scalar components."
Andre Vehreschild
vehre@gcc.gnu.org
Fri Jan 28 09:35:33 GMT 2022
https://gcc.gnu.org/g:6da86c254aa4d68aab2b1f501a88d53f8777178b
commit r12-6911-g6da86c254aa4d68aab2b1f501a88d53f8777178b
Author: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri Jan 28 10:35:07 2022 +0100
Revert "Prevent malicious descriptor stacking for scalar components."
Breaks bootstrap.
This reverts commit c9c48ab7bad9fe5e096076e56a60ce0a5a2b65f7.
Diff:
---
gcc/fortran/trans-array.cc | 71 ++++++++--------------
gcc/fortran/trans-intrinsic.cc | 40 ++++++------
.../gfortran.dg/coarray_collectives_18.f90 | 37 -----------
3 files changed, 43 insertions(+), 105 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1234932aaff..2f0c8a4d412 100644
--- 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 e680de1dbd1..da854fad89d 100644
--- 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
index c83899de0e5..00000000000
--- 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" } }
-
More information about the Gcc-cvs
mailing list