* [PATCH] Fortran: fix reallocation on assignment of polymorphic variables [PR110415]
@ 2023-11-20 13:56 Andrew Jenner
2023-11-20 14:48 ` Tobias Burnus
0 siblings, 1 reply; 2+ messages in thread
From: Andrew Jenner @ 2023-11-20 13:56 UTC (permalink / raw)
To: fortran
[-- Attachment #1: Type: text/plain, Size: 2563 bytes --]
(I sent this to gcc-patches on Wednesday - didn't realise until today
that I needed to send it here too.)
This patch adds the testcase from PR110415 and fixes the bug.
The problem is that in a couple of places in trans_class_assignment in
trans-expr.cc, we need to get the run-time size of the polymorphic
object from the vtbl, but we are currently getting that vtbl from the
lhs of the assignment rather than the rhs. This gives us the old value
of the size but we need to pass the new size to __builtin_malloc and
__builtin_realloc.
I'm fixing this by adding a parameter to trans_class_vptr_len_assignment
to retrieve the tree corresponding the vptr from the object on the rhs
of the assignment, and then passing this where it is needed. In the case
where trans_class_vptr_len_assignment returns NULL_TREE for the rhs vptr
we use the lhs vptr as before.
To get this to work I also needed to change the implementation of
trans_class_vptr_len_assignment to create a temporary for the assignment
in more circumstances. Currently, the "a = func()" assignment in MAIN__
doesn't hit the "Create a temporary for complication expressions" case
on line 9951 because "DECL_P (rse->expr)" is true - the expression has
already been placed into a temporary. That means we don't hit the "if
(temp_rhs ..." case on line 10038 and go on to get the vptr_expr from
"gfc_lval_expr_from_sym (gfc_find_vtab (&re->ts))" on line 10057 which
is the vtbl of the static type rather than the dynamic one from the rhs.
So with this fix we create an extra temporary, but that should be
optimised away in the middle-end so there should be no run-time effect.
I'm not sure if this is the best way to fix this (the Fortran front-end
is new territory for me) but I've verified that the testcase passes with
this change, fails without it, and that the change does not introduce
any FAILs when running the gfortran testcases on x86_64-pc-linux-gnu.
Is this OK for mainline, GCC 13 and OG13?
Thanks,
Andrew
gcc/fortran/
* trans-expr.cc (trans_class_vptr_len_assignment): Add
from_vptrp parameter. Populate it. Don't check for DECL_P
when deciding whether to create temporary.
(trans_class_pointer_fcn, gfc_trans_pointer_assignment): Add
NULL argument to trans_class_vptr_len_assignment calls.
(trans_class_assignment): Get rhs_vptr from
trans_class_vptr_len_assignment and use it for determining size
for allocation/reallocation.
gcc/testsuite/
* gfortran.dg/pr110415.f90: New test.
[-- Attachment #2: pr110415.patch --]
[-- Type: text/plain, Size: 6008 bytes --]
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 50c4604a025..f1618b55add 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9936,7 +9936,8 @@ trans_get_upoly_len (stmtblock_t *block, gfc_expr *expr)
static tree
trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
gfc_expr * re, gfc_se *rse,
- tree * to_lenp, tree * from_lenp)
+ tree * to_lenp, tree * from_lenp,
+ tree * from_vptrp)
{
gfc_se se;
gfc_expr * vptr_expr;
@@ -9944,10 +9945,11 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
bool set_vptr = false, temp_rhs = false;
stmtblock_t *pre = block;
tree class_expr = NULL_TREE;
+ tree from_vptr = NULL_TREE;
/* Create a temporary for complicated expressions. */
if (re->expr_type != EXPR_VARIABLE && re->expr_type != EXPR_NULL
- && rse->expr != NULL_TREE && !DECL_P (rse->expr))
+ && rse->expr != NULL_TREE)
{
if (re->ts.type == BT_CLASS && !GFC_CLASS_TYPE_P (TREE_TYPE (rse->expr)))
class_expr = gfc_get_class_from_expr (rse->expr);
@@ -10044,6 +10046,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
tmp = rse->expr;
se.expr = gfc_class_vptr_get (tmp);
+ from_vptr = se.expr;
if (UNLIMITED_POLY (re))
from_len = gfc_class_len_get (tmp);
@@ -10065,6 +10068,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
gfc_free_expr (vptr_expr);
gfc_add_block_to_block (block, &se.pre);
gcc_assert (se.post.head == NULL_TREE);
+ from_vptr = se.expr;
}
gfc_add_modify (pre, lhs_vptr, fold_convert (TREE_TYPE (lhs_vptr),
se.expr));
@@ -10093,11 +10097,13 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
}
}
- /* Return the _len trees only, when requested. */
+ /* Return the _len and _vptr trees only, when requested. */
if (to_lenp)
*to_lenp = to_len;
if (from_lenp)
*from_lenp = from_len;
+ if (from_vptrp)
+ *from_vptrp = from_vptr;
return lhs_vptr;
}
@@ -10166,7 +10172,7 @@ trans_class_pointer_fcn (stmtblock_t *block, gfc_se *lse, gfc_se *rse,
{
expr1_vptr = trans_class_vptr_len_assignment (block, expr1,
expr2, rse,
- NULL, NULL);
+ NULL, NULL, NULL);
gfc_add_block_to_block (block, &rse->pre);
tmp = gfc_create_var (TREE_TYPE (rse->expr), "ptrtemp");
gfc_add_modify (&lse->pre, tmp, rse->expr);
@@ -10242,7 +10248,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
if (non_proc_ptr_assign && expr1->ts.type == BT_CLASS)
{
trans_class_vptr_len_assignment (&block, expr1, expr2, &rse, NULL,
- NULL);
+ NULL, NULL);
lse.expr = gfc_class_data_get (lse.expr);
}
@@ -10371,7 +10377,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
if (expr1->ts.type == BT_CLASS)
expr1_vptr = trans_class_vptr_len_assignment (&block, expr1,
expr2, &rse,
- NULL, NULL);
+ NULL, NULL,
+ NULL);
}
}
else if (expr2->expr_type == EXPR_VARIABLE)
@@ -10388,7 +10395,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
rse.expr = NULL_TREE;
rse.string_length = strlen_rhs;
trans_class_vptr_len_assignment (&block, expr1, expr2, &rse,
- NULL, NULL);
+ NULL, NULL, NULL);
}
if (remap == NULL)
@@ -10421,7 +10428,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
{
expr1_vptr = trans_class_vptr_len_assignment (&block, expr1,
expr2, &rse, NULL,
- NULL);
+ NULL, NULL);
gfc_add_block_to_block (&block, &rse.pre);
tmp = gfc_create_var (TREE_TYPE (rse.expr), "ptrtemp");
gfc_add_modify (&lse.pre, tmp, rse.expr);
@@ -11819,7 +11826,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
gfc_se *lse, gfc_se *rse, bool use_vptr_copy,
bool class_realloc)
{
- tree tmp, fcn, stdcopy, to_len, from_len, vptr, old_vptr;
+ tree tmp, fcn, stdcopy, to_len, from_len, vptr, old_vptr, rhs_vptr;
vec<tree, va_gc> *args = NULL;
bool final_expr;
@@ -11843,7 +11850,9 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
}
vptr = trans_class_vptr_len_assignment (block, lhs, rhs, rse, &to_len,
- &from_len);
+ &from_len, &rhs_vptr);
+ if (rhs_vptr == NULL_TREE)
+ rhs_vptr = vptr;
/* Generate (re)allocation of the lhs. */
if (class_realloc)
@@ -11856,7 +11865,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
else
old_vptr = build_int_cst (TREE_TYPE (vptr), 0);
- size = gfc_vptr_size_get (vptr);
+ size = gfc_vptr_size_get (rhs_vptr);
tmp = lse->expr;
class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
? gfc_class_data_get (tmp) : tmp;
@@ -11875,7 +11884,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
fold_convert (pvoid_type_node, class_han),
size);
tmp = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, vptr, old_vptr);
+ logical_type_node, rhs_vptr, old_vptr);
re = fold_build3_loc (input_location, COND_EXPR, void_type_node,
tmp, re, build_empty_stmt (input_location));
gfc_add_expr_to_block (&re_alloc, re);
diff --git a/gcc/testsuite/gfortran.dg/pr110415.f90 b/gcc/testsuite/gfortran.dg/pr110415.f90
new file mode 100644
index 00000000000..f647cc4c52c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr110415.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
+!
+ type, abstract :: p
+ end type p
+
+ type, extends(p) :: c
+ end type c
+
+ class(p), allocatable :: a
+
+ a = func()
+contains
+ function func() result(a)
+ class(p), allocatable :: a
+
+ a = c()
+ end function func
+end program
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [PATCH] Fortran: fix reallocation on assignment of polymorphic variables [PR110415]
2023-11-20 13:56 [PATCH] Fortran: fix reallocation on assignment of polymorphic variables [PR110415] Andrew Jenner
@ 2023-11-20 14:48 ` Tobias Burnus
0 siblings, 0 replies; 2+ messages in thread
From: Tobias Burnus @ 2023-11-20 14:48 UTC (permalink / raw)
To: Andrew Jenner, fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2655 bytes --]
Hi Andrew,
On 20.11.23 14:56, Andrew Jenner wrote:
> This patch adds the testcase from PR110415 and fixes the bug.
Thanks. I can confirm experimentally that it fixes the original PR. However, if I extend
the original testcase (-2), it fails with run with valgrind or when run with -fsanitize=address.
The array testcase (-3) seems to be fine with and without your patch.
I think it makes sense to include both extended testcases and put them under
gcc/testsuite/gfortran.dg/asan/ to ensure ASAN checks for leaks and some invalid memory access.
I still should have a closer look at the -ftree-dump-original and at the patch itself.
* * *
For the '-2' testcase, ASAN (-fsanitize=undefined) shows:
==11823==ERROR: AddressSanitizer: heap-use-after-free on address 0x608000000220 at pc 0x000000405d39 bp 0x7ffcfa6eef50 sp 0x7ffcfa6eef48
WRITE of size 96 at 0x608000000220 thread T0
#0 0x405d38 in __copy_MAIN___D gcc/testsuite/gfortran.dg/pr110415.f90:5
#1 0x404dc0 in MAIN__ gcc/testsuite/gfortran.dg/pr110415.f90:24
#2 0x40a82b in main gcc/testsuite/gfortran.dg/pr110415.f90:28
#3 0x7f1e2a4281af in __libc_start_call_main (/lib64/libc.so.6+0x281af) (BuildId: bbeee08e5f56966e641c4f3ba4ea1da9d730d0ab)
#4 0x7f1e2a428278 in __libc_start_main@@GLIBC_2.34 (/lib64/libc.so.6+0x28278) (BuildId: bbeee08e5f56966e641c4f3ba4ea1da9d730d0ab)
#5 0x402274 in _start ../sysdeps/x86_64/start.S:115
0x608000000220 is located 0 bytes inside of 96-byte region [0x608000000220,0x608000000280)
freed by thread T0 here:
#0 0x7f1e2b4daf35 (/lib64/libasan.so.8+0xdaf35) (BuildId: 3e1694ad218c99a8b1b69231666a27df63cf19d0)
#1 0x404d1c in MAIN__ gcc/testsuite/gfortran.dg/pr110415.f90:24
#2 0x40a82b in main gcc/testsuite/gfortran.dg/pr110415.f90:28
#3 0x7f1e2a4281af in __libc_start_call_main (/lib64/libc.so.6+0x281af) (BuildId: bbeee08e5f56966e641c4f3ba4ea1da9d730d0ab)
previously allocated by thread T0 here:
#0 0x7f1e2b4dc03f in malloc (/lib64/libasan.so.8+0xdc03f) (BuildId: 3e1694ad218c99a8b1b69231666a27df63cf19d0)
#1 0x4042d2 in MAIN__ gcc/testsuite/gfortran.dg/pr110415.f90:22
#2 0x40a82b in main gcc/testsuite/gfortran.dg/pr110415.f90:28
#3 0x7f1e2a4281af in __libc_start_call_main (/lib64/libc.so.6+0x281af) (BuildId: bbeee08e5f56966e641c4f3ba4ea1da9d730d0ab)
* * *
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: pr110415-2.f90 --]
[-- Type: text/x-fortran, Size: 780 bytes --]
! { dg-do run }
!
! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
implicit none
type, abstract :: p
integer :: a = 4
end type p
type, extends(p) :: c
integer :: b = 7
character(len=:), allocatable :: str, str2(:)
end type c
type, extends(p) :: d
integer :: ef = 7
character(len=:), allocatable :: str, str2(:)
end type d
class(p), allocatable :: a
a = func()
a = func2()
a = func()
deallocate(a)
contains
function func2() result(a)
class(p), allocatable :: a
a = d()
end function func2
function func() result(a)
class(p), allocatable :: a
a = c()
select type(a)
type is (c)
a%str = 'abcd'
a%str2 = ['abcd','efgh']
end select
end function func
end program
[-- Attachment #3: pr110415-3.f90 --]
[-- Type: text/x-fortran, Size: 927 bytes --]
! { dg-do run }
!
! Contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
implicit none
type, abstract :: p
integer :: a = 4
end type p
type, extends(p) :: c
integer :: b = 7
character(len=:), allocatable :: str, str2(:)
end type c
type, extends(p) :: d
integer :: ef = 7
character(len=:), allocatable :: str, str2(:)
end type d
class(p), allocatable :: a(:)
a = func()
a = func2()
a = func()
deallocate(a)
contains
function func2() result(a)
class(p), allocatable :: a(:)
a = [d(),d()]
end function func2
function func() result(a)
class(p), allocatable :: a(:)
a = [c(),c(),c()]
select type(a)
type is (c)
a(1)%str = 'abcd'
a(2)%str = 'abc'
a(3)%str = 'abcd4'
a(1)%str2 = ['abcd','efgh']
a(2)%str2 = ['bcd','fgh']
a(3)%str2 = ['abcd6','efgh7']
end select
end function func
end program
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-11-20 14:49 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-20 13:56 [PATCH] Fortran: fix reallocation on assignment of polymorphic variables [PR110415] Andrew Jenner
2023-11-20 14:48 ` Tobias Burnus
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).