Hello,
This is a simple patch that fixes PR 4755. Currently the ALLOCATE
statement will free and re-allocate an already allocated scalar. The
Fortran standard says that this is an error. The attached patch fixes
the problem.
I am also attaching two tree dumps of the same program, compiled before
and after the application of this patch. The test program is this:
program test
integer, allocatable :: A(:), B[:]
integer :: stat
character(len=33) :: str
allocate(A(1), B[*], stat=stat)
end program
If you compare the "before" and "after" files you'll see that with this
patch GCC no longer tries to free and reallocate A(1). You will also
notice that the block for B[*] didn't change. The block for B[*] is
already correct in trunk and doesn't need changing.
Here is my ChangeLog:
2011-07-22 Daniel Carrera <dcarr...@gmail.com>
* trans.c (gfc__allocate_allocatable): [PR 4755] Do not fix
and the reallocate a variable that is already allocated.
--
I'm not overweight, I'm undertall.
diff -r c8b6eb02738a gcc/fortran/trans.c
--- a/gcc/fortran/trans.c Fri Jul 22 09:21:49 2011 +0000
+++ b/gcc/fortran/trans.c Fri Jul 22 20:36:23 2011 +0200
@@ -775,13 +775,8 @@ gfc_allocate_allocatable (stmtblock_t *
stmtblock_t set_status_block;
gfc_start_block (&set_status_block);
- tmp = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_FREE], 1,
- fold_convert (pvoid_type_node, mem));
- gfc_add_expr_to_block (&set_status_block, tmp);
- tmp = gfc_allocate_using_malloc (&set_status_block, size, status);
- gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
+ gfc_add_modify (&set_status_block, res, fold_convert (type, mem));
gfc_add_modify (&set_status_block, status,
build_int_cst (status_type, LIBERROR_ALLOCATION));
test ()
{
struct array1_integer(kind=4) a;
struct array1_integer(kind=4) b;
integer(kind=4) stat;
try
{
a.data = 0B;
b.data = 0B;
{
integer(kind=4) overflow.1;
integer(kind=4) D.1537;
integer(kind=4) D.1536;
integer(kind=4) stat.0;
a.dtype = 265;
a.dim[0].lbound = 1;
a.dim[0].ubound = 1;
a.dim[0].stride = 1;
D.1536 = (logical(kind=4)) 0 ? 0 : (logical(kind=4)) 0 ? 1 : 0;
D.1537 = ((logical(kind=4)) 0 ? 0 : (logical(kind=4)) 0 ? 1 : 0) +
D.1536;
overflow.1 = D.1537;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>)
(overflow.1 != 0), 0))
{
stat.0 = 5014;
}
else
{
{
void * restrict D.1539;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>)
(a.data != 0B), 0))
{
D.1539 = a.data;
stat.0 = 5014;
}
else
{
{
void * restrict D.1540;
stat.0 = 0;
D.1540 = (void * restrict) __builtin_malloc (4);
if (D.1540 == 0B)
{
stat.0 = 5014;
}
D.1539 = D.1540;
}
}
a.data = D.1539;
}
}
a.offset = -1;
if (stat.0 != 0) goto L.1;
b.dtype = 264;
b.dim[0].lbound = 1;
{
void * restrict D.1541;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>) (b.data
!= 0B), 0))
{
D.1541 = b.data;
stat.0 = 5014;
}
else
{
{
void * restrict D.1542;
D.1542 = (void * restrict) _gfortran_caf_register (4, 1, 0B,
&stat.0, 0B, 0);
D.1541 = D.1542;
}
}
b.data = D.1541;
}
if (stat.0 != 0) goto L.2;
L.1:;
L.2:;
stat = stat.0;
}
}
finally
{
if (b.data != 0B)
{
__builtin_free ((void *) b.data);
}
b.data = 0B;
if (a.data != 0B)
{
__builtin_free ((void *) a.data);
}
a.data = 0B;
}
}
main (integer(kind=4) argc, character(kind=1) * * argv)
{
static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
_gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image,
&_gfortran_caf_num_images);
_gfortran_set_args (argc, argv);
_gfortran_set_options (8, &options.2[0]);
test ();
__sync_synchronize ();
_gfortran_caf_finalize ();
return 0;
}
test ()
{
struct array1_integer(kind=4) a;
struct array1_integer(kind=4) b;
integer(kind=4) stat;
try
{
a.data = 0B;
b.data = 0B;
{
integer(kind=4) overflow.1;
integer(kind=4) D.1537;
integer(kind=4) D.1536;
integer(kind=4) stat.0;
a.dtype = 265;
a.dim[0].lbound = 1;
a.dim[0].ubound = 1;
a.dim[0].stride = 1;
D.1536 = (logical(kind=4)) 0 ? 0 : (logical(kind=4)) 0 ? 1 : 0;
D.1537 = ((logical(kind=4)) 0 ? 0 : (logical(kind=4)) 0 ? 1 : 0) +
D.1536;
overflow.1 = D.1537;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>)
(overflow.1 != 0), 0))
{
stat.0 = 5014;
}
else
{
{
void * restrict D.1539;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>)
(a.data != 0B), 0))
{
{
void * restrict D.1541;
__builtin_free ((void *) a.data);
stat.0 = 0;
D.1541 = (void * restrict) __builtin_malloc (4);
if (D.1541 == 0B)
{
stat.0 = 5014;
}
D.1539 = D.1541;
stat.0 = 5014;
}
}
else
{
{
void * restrict D.1540;
stat.0 = 0;
D.1540 = (void * restrict) __builtin_malloc (4);
if (D.1540 == 0B)
{
stat.0 = 5014;
}
D.1539 = D.1540;
}
}
a.data = D.1539;
}
}
a.offset = -1;
if (stat.0 != 0) goto L.1;
b.dtype = 264;
b.dim[0].lbound = 1;
{
void * restrict D.1542;
if ((logical(kind=4)) __builtin_expect ((<unnamed-signed:32>) (b.data
!= 0B), 0))
{
{
void * restrict D.1544;
__builtin_free ((void *) b.data);
stat.0 = 0;
D.1544 = (void * restrict) __builtin_malloc (4);
if (D.1544 == 0B)
{
stat.0 = 5014;
}
D.1542 = D.1544;
stat.0 = 5014;
}
}
else
{
{
void * restrict D.1543;
D.1543 = (void * restrict) _gfortran_caf_register (4, 1, 0B,
&stat.0, 0B, 0);
D.1542 = D.1543;
}
}
b.data = D.1542;
}
if (stat.0 != 0) goto L.2;
L.1:;
L.2:;
stat = stat.0;
}
}
finally
{
if (b.data != 0B)
{
__builtin_free ((void *) b.data);
}
b.data = 0B;
if (a.data != 0B)
{
__builtin_free ((void *) a.data);
}
a.data = 0B;
}
}
main (integer(kind=4) argc, character(kind=1) * * argv)
{
static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1};
_gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image,
&_gfortran_caf_num_images);
_gfortran_set_args (argc, argv);
_gfortran_set_options (8, &options.2[0]);
test ();
__sync_synchronize ();
_gfortran_caf_finalize ();
return 0;
}
