summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/trans-decl.c6
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/bounds_check_16.f9014
-rw-r--r--libgfortran/io/transfer.c37
5 files changed, 66 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 986ee2d01e1..abaa344c12e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
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
* symbol.c (gfc_find_component): Fix access check of parent
components.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 67bd3e233f0..50b64740b99 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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"
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 452fdddab13..30f16099369 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
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
* gfortran.dg/private_type_14.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_16.f90 b/gcc/testsuite/gfortran.dg/bounds_check_16.f90
new file mode 100644
index 00000000000..38a86306e93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_16.f90
@@ -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
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 976102f3a8e..f71e96f75de 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -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);
View Lorry Controller Status