* [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block
@ 2015-07-06 12:58 Andre Vehreschild
2015-07-06 19:36 ` Paul Richard Thomas
0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2015-07-06 12:58 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML; +Cc: Paul Richard Thomas, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 1071 bytes --]
Hi all,
this is a proposal to patch PR 66578
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66578 . It extends work of Mikael
Morin. The patch fixes two issues:
1. a source'd allocate in a block: allocate(c, source=a(:)). The issues occurs
because due to the new handling of source-expressions in trans_allocate() an
array descriptor is created where previously just a plain array was used. I.e.,
GFC_DESCRIPTOR_TYPE_P (source) is true now and GFC_ARRAY_TYPE_P (source) false,
which made gfortran use the wrong bounds for the descriptor (zero-based instead
of one-based). This was fixed by Mikael's proposal.
2. a two-level array addressing lead to a segfault. I.e., when in a
source-expression an array was used to index another object, then the offset
was computed incorrectly.
Bootstraps and regtests fine on x86_64-linux-gnu/f21.
Comments welcome!
Regards,
Andre
PS: Experience shows that asking whether this ok for trunk is useless ;-) There
is always something that could be improved. Open for suggestions.
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr66578_1.clog --]
[-- Type: application/octet-stream, Size: 354 bytes --]
gcc/testsuite/ChangeLog:
2015-07-06 Andre Vehreschild <vehre@gmx.de>
* gfortran.dg/allocate_with_source_9.f08: New test.
gcc/fortran/ChangeLog:
2015-07-06 Andre Vehreschild <vehre@gmx.de>
* 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.
[-- Attachment #3: pr66578_1.patch --]
[-- Type: text/x-patch, Size: 5058 bytes --]
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index fece3ab..afea5ec 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08
new file mode 100644
index 0000000..aa7cb47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08
@@ -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
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block
2015-07-06 12:58 [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block Andre Vehreschild
@ 2015-07-06 19:36 ` Paul Richard Thomas
2015-07-06 19:42 ` Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2015-07-06 19:36 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Mikael Morin
Dear Andre,
Whilst it is probably OK in most circumstances, I would change:
s/rank_remap = ss->dimen < ndim/rank_remap = ss->dimen < ndim != 0
Apart from that, it is indeed OK for trunk, in spite of your expectations :-)
Thanks for the patch
Paul
On 6 July 2015 at 14:58, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> this is a proposal to patch PR 66578
> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66578 . It extends work of Mikael
> Morin. The patch fixes two issues:
>
> 1. a source'd allocate in a block: allocate(c, source=a(:)). The issues occurs
> because due to the new handling of source-expressions in trans_allocate() an
> array descriptor is created where previously just a plain array was used. I.e.,
> GFC_DESCRIPTOR_TYPE_P (source) is true now and GFC_ARRAY_TYPE_P (source) false,
> which made gfortran use the wrong bounds for the descriptor (zero-based instead
> of one-based). This was fixed by Mikael's proposal.
>
> 2. a two-level array addressing lead to a segfault. I.e., when in a
> source-expression an array was used to index another object, then the offset
> was computed incorrectly.
>
> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
>
> Comments welcome!
>
> Regards,
> Andre
>
> PS: Experience shows that asking whether this ok for trunk is useless ;-) There
> is always something that could be improved. Open for suggestions.
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block
2015-07-06 19:36 ` Paul Richard Thomas
@ 2015-07-06 19:42 ` Andre Vehreschild
2015-07-06 19:55 ` Paul Richard Thomas
0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2015-07-06 19:42 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Mikael Morin
Hi Paul,
Thanks for the review, but I don't understand the regexp. rank_remap = ss->dimen < ndim != 0 in my eyes is not a legal expression. Did you mean something like rank_remap = ss->dimen < ndim && ndim != 0, or the like?
Regards,
Andre
Am 6. Juli 2015 21:36:18 MESZ, schrieb Paul Richard Thomas <paul.richard.thomas@gmail.com>:
>Dear Andre,
>
>Whilst it is probably OK in most circumstances, I would change:
>s/rank_remap = ss->dimen < ndim/rank_remap = ss->dimen < ndim != 0
>
>Apart from that, it is indeed OK for trunk, in spite of your
>expectations :-)
>
>Thanks for the patch
>
>Paul
>
>On 6 July 2015 at 14:58, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi all,
>>
>> this is a proposal to patch PR 66578
>> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66578 . It extends work
>of Mikael
>> Morin. The patch fixes two issues:
>>
>> 1. a source'd allocate in a block: allocate(c, source=a(:)). The
>issues occurs
>> because due to the new handling of source-expressions in
>trans_allocate() an
>> array descriptor is created where previously just a plain array was
>used. I.e.,
>> GFC_DESCRIPTOR_TYPE_P (source) is true now and GFC_ARRAY_TYPE_P
>(source) false,
>> which made gfortran use the wrong bounds for the descriptor
>(zero-based instead
>> of one-based). This was fixed by Mikael's proposal.
>>
>> 2. a two-level array addressing lead to a segfault. I.e., when in a
>> source-expression an array was used to index another object, then the
>offset
>> was computed incorrectly.
>>
>> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
>>
>> Comments welcome!
>>
>> Regards,
>> Andre
>>
>> PS: Experience shows that asking whether this ok for trunk is useless
>;-) There
>> is always something that could be improved. Open for suggestions.
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Mail: vehre@gmx.de * Tel.: +49 241 9291018
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block
2015-07-06 19:42 ` Andre Vehreschild
@ 2015-07-06 19:55 ` Paul Richard Thomas
2015-07-07 11:11 ` Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2015-07-06 19:55 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Mikael Morin
Andre,
Forget my comment. I was seeing arrows all pointing in one direction !
Cheers
Paul
On 6 July 2015 at 21:42, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Paul,
>
> Thanks for the review, but I don't understand the regexp. rank_remap = ss->dimen < ndim != 0 in my eyes is not a legal expression. Did you mean something like rank_remap = ss->dimen < ndim && ndim != 0, or the like?
>
> Regards,
> Andre
>
> Am 6. Juli 2015 21:36:18 MESZ, schrieb Paul Richard Thomas <paul.richard.thomas@gmail.com>:
>>Dear Andre,
>>
>>Whilst it is probably OK in most circumstances, I would change:
>>s/rank_remap = ss->dimen < ndim/rank_remap = ss->dimen < ndim != 0
>>
>>Apart from that, it is indeed OK for trunk, in spite of your
>>expectations :-)
>>
>>Thanks for the patch
>>
>>Paul
>>
>>On 6 July 2015 at 14:58, Andre Vehreschild <vehre@gmx.de> wrote:
>>> Hi all,
>>>
>>> this is a proposal to patch PR 66578
>>> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66578 . It extends work
>>of Mikael
>>> Morin. The patch fixes two issues:
>>>
>>> 1. a source'd allocate in a block: allocate(c, source=a(:)). The
>>issues occurs
>>> because due to the new handling of source-expressions in
>>trans_allocate() an
>>> array descriptor is created where previously just a plain array was
>>used. I.e.,
>>> GFC_DESCRIPTOR_TYPE_P (source) is true now and GFC_ARRAY_TYPE_P
>>(source) false,
>>> which made gfortran use the wrong bounds for the descriptor
>>(zero-based instead
>>> of one-based). This was fixed by Mikael's proposal.
>>>
>>> 2. a two-level array addressing lead to a segfault. I.e., when in a
>>> source-expression an array was used to index another object, then the
>>offset
>>> was computed incorrectly.
>>>
>>> Bootstraps and regtests fine on x86_64-linux-gnu/f21.
>>>
>>> Comments welcome!
>>>
>>> Regards,
>>> Andre
>>>
>>> PS: Experience shows that asking whether this ok for trunk is useless
>>;-) There
>>> is always something that could be improved. Open for suggestions.
>>> --
>>> Andre Vehreschild * Email: vehre ad gmx dot de
>
> --
> Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> Mail: vehre@gmx.de * Tel.: +49 241 9291018
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block
2015-07-06 19:55 ` Paul Richard Thomas
@ 2015-07-07 11:11 ` Andre Vehreschild
0 siblings, 0 replies; 5+ messages in thread
From: Andre Vehreschild @ 2015-07-07 11:11 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 138 bytes --]
Hi all, hi Paul,
Paul thanks for the review. Committed as r225507.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 5355 bytes --]
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 223641)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5877,5882 ****
--- 5877,5896 ----
fntype = TREE_TYPE (TREE_TYPE (se->expr));
se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
+ /* Allocatable scalar function results must be freed and nullified
+ after use. This necessitates the creation of a temporary to
+ hold the result to prevent duplicate calls. */
+ if (!byref && sym->ts.type != BT_CHARACTER
+ && sym->attr.allocatable && !sym->attr.dimension)
+ {
+ tmp = gfc_create_var (TREE_TYPE (se->expr), NULL);
+ gfc_add_modify (&se->pre, tmp, se->expr);
+ se->expr = tmp;
+ tmp = gfc_call_free (tmp);
+ gfc_add_expr_to_block (&post, tmp);
+ gfc_add_modify (&post, se->expr, build_int_cst (TREE_TYPE (se->expr), 0));
+ }
+
/* If we have a pointer function, but we don't want a pointer, e.g.
something like
x = f()
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 223641)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5214,5219 ****
--- 5214,5220 ----
false, false);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_block_to_block (&post, &se.post);
+
/* Prevent aliasing, i.e., se.expr may be already a
variable declaration. */
if (!VAR_P (se.expr))
*************** gfc_trans_allocate (gfc_code * code)
*** 5223,5230 ****
se.expr);
/* We need a regular (non-UID) symbol here, therefore give a
prefix. */
! var = gfc_create_var (TREE_TYPE (tmp), "atmp");
gfc_add_modify_loc (input_location, &block, var, tmp);
tmp = var;
}
else
--- 5224,5243 ----
se.expr);
/* We need a regular (non-UID) symbol here, therefore give a
prefix. */
! var = gfc_create_var (TREE_TYPE (tmp), "expr3");
gfc_add_modify_loc (input_location, &block, var, tmp);
+
+ /* Deallocate any allocatable components after all the allocations
+ and assignments of expr3 have been completed. */
+ if (code->expr3->ts.type == BT_DERIVED
+ && code->expr3->rank == 0
+ && code->expr3->ts.u.derived->attr.alloc_comp)
+ {
+ tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
+ var, 0);
+ gfc_add_expr_to_block (&post, tmp);
+ }
+
tmp = var;
}
else
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (working copy)
***************
*** 0 ****
--- 1,70 ----
+ ! { dg-do run }
+ ! { dg-options "-fdump-tree-original" }
+ !
+ ! Test the fix for PR66079. The original problem was with the first
+ ! allocate statement. The rest of this testcase fixes problems found
+ ! whilst working on it!
+ !
+ ! Reported by Damian Rouson <damian@sourceryinstitute.org>
+ !
+ type subdata
+ integer, allocatable :: b
+ endtype
+ ! block
+ call newRealVec
+ ! end block
+ contains
+ subroutine newRealVec
+ type(subdata), allocatable :: d, e, f
+ character(:), allocatable :: g, h, i
+ character(8), allocatable :: j
+ allocate(d,source=subdata(1)) ! memory was lost, now OK
+ allocate(e,source=d) ! OK
+ allocate(f,source=create (99)) ! memory was lost, now OK
+ if (d%b .ne. 1) call abort
+ if (e%b .ne. 1) call abort
+ if (f%b .ne. 99) call abort
+ allocate (g, source = greeting1("good day"))
+ if (g .ne. "good day") call abort
+ allocate (h, source = greeting2("hello"))
+ if (h .ne. "hello") call abort
+ allocate (i, source = greeting3("hiya!"))
+ if (i .ne. "hiya!") call abort
+ call greeting4 (j, "Goodbye ") ! Test that dummy arguments are OK
+ if (j .ne. "Goodbye ") call abort
+ end subroutine
+
+ function create (arg) result(res)
+ integer :: arg
+ type(subdata), allocatable :: res, res1
+ allocate(res, res1, source = subdata(arg))
+ end function
+
+ function greeting1 (arg) result(res) ! memory was lost, now OK
+ character(*) :: arg
+ Character(:), allocatable :: res
+ allocate(res, source = arg)
+ end function
+
+ function greeting2 (arg) result(res)
+ character(5) :: arg
+ Character(:), allocatable :: res
+ allocate(res, source = arg)
+ end function
+
+ function greeting3 (arg) result(res)
+ character(5) :: arg
+ Character(5), allocatable :: res, res1
+ allocate(res, res1, source = arg) ! Caused an ICE
+ if (res1 .ne. res) call abort
+ end function
+
+ subroutine greeting4 (res, arg)
+ character(8), intent(in) :: arg
+ Character(8), allocatable, intent(out) :: res
+ allocate(res, source = arg) ! Caused an ICE
+ end subroutine
+ end
+ ! { dg-final { scan-tree-dump-times "builtin_malloc" 20 "original" } }
+ ! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }
+ ! { dg-final { cleanup-tree-dump "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2015-07-07 11:11 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-07-06 12:58 [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block Andre Vehreschild
2015-07-06 19:36 ` Paul Richard Thomas
2015-07-06 19:42 ` Andre Vehreschild
2015-07-06 19:55 ` Paul Richard Thomas
2015-07-07 11:11 ` 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).