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

re PR fortran/50815 (ICE on allocation of deferred length character scalar dummy argument when -fbounds-check)

Browse source 
2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/50815
        * trans-decl.c (add_argument_checking): Skip bound checking
        for deferred-length strings.

2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/50815
        * gfortran.dg/bounds_check_16.f90: New.

From-SVN: r182134
This commit is contained in:
Tobias Burnus 2011-12-08 20:00:55 +01:00 • committed by Tobias Burnus
parent 3787b8ffe0
commit 3215710740
5 changed files with 66 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/50815
* trans-decl.c (add_argument_checking): Skip bound checking
for deferred-length strings.
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51378

6
gcc/fortran/trans-decl.c
View file

@ -4695,8 +4695,10 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
if the actual argument is (part of) an array, but only if the
dummy argument is an array. (See "Sequence association" in
Section 12.4.1.4 for F95 and 12.4.1.5 for F2003.) */
if (fsym->attr.pointer || fsym->attr.allocatable
|| (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
if (fsym->ts.deferred)
continue;
else if (fsym->attr.pointer || fsym->attr.allocatable
|| (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
{
comparison = NE_EXPR;
message = _("Actual string length does not match the declared one"

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/50815
* gfortran.dg/bounds_check_16.f90: New.
2011-12-08 Tobias Burnus <burnus@net-b.de>
PR fortran/51378

14
gcc/testsuite/gfortran.dg/bounds_check_16.f90 Normal file
View file

@ -0,0 +1,14 @@
! { dg-do compile }
! { dg-options "-fcheck=bounds" }
!
! PR fortran/50815
!
! Don't check the bounds of deferred-length strings.
! gfortran had an ICE before because it did.
!
SUBROUTINE TEST(VALUE)
IMPLICIT NONE
CHARACTER(LEN=:), ALLOCATABLE :: VALUE
CHARACTER(LEN=128) :: VAL
VALUE = VAL
END SUBROUTINE TEST

37
libgfortran/io/transfer.c
View file

@ -1063,6 +1063,25 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f)
}
static int
require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f)
{
#define BUFLEN 100
char buffer[BUFLEN];
if (actual == BT_INTEGER || actual == BT_REAL || actual == BT_COMPLEX)
return 0;
/* Adjust item_count before emitting error message. */
snprintf (buffer, BUFLEN,
"Expected numeric type for item %d in formatted transfer, got %s",
dtp->u.p.item_count - 1, type_name (actual));
format_error (dtp, f, buffer);
return 1;
}
/* This function is in the main loop for a formatted data transfer
statement. It would be natural to implement this as a coroutine
with the user program, but C makes that awkward. We loop,
@ -1147,6 +1166,9 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
if (n == 0)
goto need_read_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
read_radix (dtp, f, p, kind, 2);
@ -1156,6 +1178,9 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
if (n == 0)
goto need_read_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
read_radix (dtp, f, p, kind, 8);
@ -1165,6 +1190,9 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
if (n == 0)
goto need_read_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
read_radix (dtp, f, p, kind, 16);
@ -1548,6 +1576,9 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (n == 0)
goto need_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
write_b (dtp, f, p, kind);
@ -1557,6 +1588,9 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (n == 0)
goto need_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
write_o (dtp, f, p, kind);
@ -1566,6 +1600,9 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
if (n == 0)
goto need_data;
if (!(compile_options.allow_std & GFC_STD_GNU)
&& require_numeric_type (dtp, type, f))
return;
if (!(compile_options.allow_std & GFC_STD_F2008)
&& require_type (dtp, BT_INTEGER, type, f))
return;
write_z (dtp, f, p, kind);