public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-6910] Prevent malicious descriptor stacking for scalar components.
@ 2022-01-28 9:05 Andre Vehreschild
0 siblings, 0 replies; only message in thread
From: Andre Vehreschild @ 2022-01-28 9:05 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c9c48ab7bad9fe5e096076e56a60ce0a5a2b65f7
commit r12-6910-gc9c48ab7bad9fe5e096076e56a60ce0a5a2b65f7
Author: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri Jan 28 09:20:23 2022 +0100
Prevent malicious descriptor stacking for scalar components.
gcc/fortran/ChangeLog:
PR fortran/103790
* trans-array.cc (structure_alloc_comps): Prevent descriptor
stacking for non-array data; do not broadcast caf-tokens.
* trans-intrinsic.cc (conv_co_collective): Prevent generation
of unused descriptor.
gcc/testsuite/ChangeLog:
PR fortran/103790
* gfortran.dg/coarray_collectives_18.f90: New test.
Diff:
---
gcc/fortran/trans-array.cc | 71 ++++++++++++++--------
gcc/fortran/trans-intrinsic.cc | 40 ++++++------
.../gfortran.dg/coarray_collectives_18.f90 | 37 +++++++++++
3 files changed, 105 insertions(+), 43 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2f0c8a4d412..1234932aaff 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9102,6 +9102,10 @@ 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)
@@ -9134,10 +9138,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
if (attr->dimension)
{
tmp = gfc_get_element_type (TREE_TYPE (comp));
- ubound = gfc_full_array_size (&tmpblock, comp,
- c->ts.type == BT_CLASS
- ? CLASS_DATA (c)->as->rank
- : c->as->rank);
+ 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);
}
else
{
@@ -9145,26 +9152,36 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
ubound = build_int_cst (gfc_array_index_type, 1);
}
- cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
- &ubound, 1,
- GFC_ARRAY_ALLOCATABLE, false);
+ /* 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_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)
- comp = gfc_conv_descriptor_data_get (comp);
+ {
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
+ comp = gfc_conv_descriptor_data_get (comp);
+ else
+ comp = gfc_build_addr_expr (NULL_TREE, comp);
+ }
else
{
gfc_se se;
@@ -9172,14 +9189,18 @@ 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);
- comp = gfc_build_addr_expr (NULL_TREE, 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);
gfc_add_block_to_block (&tmpblock, &se.pre);
}
- gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
+ if (attr->dimension || c->ts.type == BT_CHARACTER)
+ gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
+ else
+ cdesc = comp;
tree fndecl;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index da854fad89d..e680de1dbd1 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11212,24 +11212,31 @@ 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 (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
+ if (!derived || !derived->attr.alloc_comp
+ || code->resolved_isym->id != GFC_ISYM_CO_BROADCAST)
{
- argse.want_pointer = 1;
- gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
- array = argse.expr;
+ 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;
+ }
}
gfc_add_block_to_block (&block, &argse.pre);
@@ -11290,9 +11297,6 @@ 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
new file mode 100644
index 00000000000..c83899de0e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
@@ -0,0 +1,37 @@
+! { 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" } }
+
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-01-28 9:05 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-28 9:05 [gcc r12-6910] Prevent malicious descriptor stacking for scalar components Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).