procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/66578 ([F2008] Invalid free on allocate(...,source=a(:)) in block)

Browse source 
gcc/testsuite/ChangeLog:

2015-07-07  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66578
	* gfortran.dg/allocate_with_source_9.f08: New test.


gcc/fortran/ChangeLog:

2015-07-07  Mikael Morin  <mikael@gcc.gnu.org>
	    Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66578
	* trans-array.c (gfc_conv_expr_descriptor): Ensure array descriptor
	is one-based for non-full array refs. Correct the offset when a
	rank_remap occurs.

From-SVN: r225507
This commit is contained in:
Andre Vehreschild 2015-07-07 13:10:12 +02:00 • committed by Andre Vehreschild
parent 970bb2de65
commit 3244f4cd04
4 changed files with 73 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2015-07-07 Andre Vehreschild <vehre@gmx.de>
PR fortran/66578
* trans-array.c (gfc_conv_expr_descriptor): Ensure array descriptor
is one-based for non-full array refs. Correct the offset when a
rank_remap occurs.
2015-07-06 Steven G. Kargl <kargl@gcc.gnu.org>
* io.c (check_char_variable): New function.

54
gcc/fortran/trans-array.c
View file

@ -6912,9 +6912,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tree from;
tree to;
tree base;
bool onebased = false;
bool onebased = false, rank_remap;
ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
rank_remap = ss->dimen < ndim;
if (se->want_coarray)
{
@ -6947,6 +6948,22 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (expr->ts.type == BT_CHARACTER)
se->string_length = gfc_get_expr_charlen (expr);
/* If we have an array section or are assigning make sure that
the lower bound is 1. References to the full
array should otherwise keep the original bounds. */
if ((!info->ref || info->ref->u.ar.type != AR_FULL) && !se->want_pointer)
for (dim = 0; dim < loop.dimen; dim++)
if (!integer_onep (loop.from[dim]))
{
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, gfc_index_one_node,
loop.from[dim]);
loop.to[dim] = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
loop.to[dim], tmp);
loop.from[dim] = gfc_index_one_node;
}
desc = info->descriptor;
if (se->direct_byref && !se->byref_noassign)
{
@ -7040,20 +7057,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
from = loop.from[dim];
to = loop.to[dim];
/* If we have an array section or are assigning make sure that
the lower bound is 1. References to the full
array should otherwise keep the original bounds. */
if ((!info->ref
|| info->ref->u.ar.type != AR_FULL)
&& !integer_onep (from))
{
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type, gfc_index_one_node,
from);
to = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, to, tmp);
from = gfc_index_one_node;
}
onebased = integer_onep (from);
gfc_conv_descriptor_lbound_set (&loop.pre, parm,
gfc_rank_cst[dim], from);
@ -7079,7 +7082,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
{
tmp = gfc_conv_array_lbound (desc, n);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (base), tmp, loop.from[dim]);
TREE_TYPE (base), tmp, from);
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (base), tmp,
gfc_conv_array_stride (desc, n));
@ -7114,7 +7117,19 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
/* Force the offset to be -1, when the lower bound of the highest
dimension is one and the symbol is present and is not a
pointer/allocatable or associated. */
if (onebased && se->use_offset
if (((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
&& !se->data_not_needed)
|| (se->use_offset && base != NULL_TREE))
{
/* Set the offset depending on base. */
tmp = rank_remap && !se->direct_byref ?
fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, base,
offset)
: base;
gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp);
}
else if (onebased && (!rank_remap || se->use_offset)
&& expr->symtree
&& !(expr->symtree->n.sym && expr->symtree->n.sym->ts.type == BT_CLASS
&& !CLASS_DATA (expr->symtree->n.sym)->attr.class_pointer)
@ -7129,11 +7144,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tmp = gfc_conv_mpz_to_tree (minus_one, gfc_index_integer_kind);
gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp);
}
else if (((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
&& !se->data_not_needed)
|| (se->use_offset && base != NULL_TREE))
/* Set the offset depending on base. */
gfc_conv_descriptor_offset_set (&loop.pre, parm, base);
else
{
/* Only the callee knows what the correct offset it, so just set

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2015-07-07 Andre Vehreschild <vehre@gmx.de>
PR fortran/66578
* gfortran.dg/allocate_with_source_9.f08: New test.
2015-07-07 Christian Bruel <christian.bruel@st.com>
PR target/52144

29
gcc/testsuite/gfortran.dg/allocate_with_source_9.f08 Normal file
View file

@ -0,0 +1,29 @@
! { dg-do run }
!
! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>,
! Andre Vehreschild <vehre@gcc.gnu.org>
program main
type T
integer, allocatable :: acc(:)
end type
integer :: n, lb, ub
integer :: vec(9)
type(T) :: o1, o2
vec = [(i, i= 1, 9)]
n = 42
lb = 7
ub = lb + 2
allocate(o1%acc, source=vec)
allocate(o2%acc, source=o1%acc(lb:ub))
if (any (o2%acc /= [7, 8, 9])) call abort()
block
real, dimension(0:n) :: a
real, dimension(:), allocatable :: c
call random_number(a)
allocate(c,source=a(:))
if (any (abs(a - c) > 1E-6)) call abort()
end block
end program main