aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@redhat.com>2009-07-23 20:09:43 +0200
committerJakub Jelinek <jakub@gcc.gnu.org>2009-07-23 20:09:43 +0200
commit88e18fedad6803c5f9abdbcf1c4a51c25e12706c (patch)
treee2355295ba4f503f046c98f919798986a5d39dbd /gcc
parent93d7c9943f56fa9b69647433a5ca89a70a19a601 (diff)
downloadgcc-88e18fedad6803c5f9abdbcf1c4a51c25e12706c.zip
gcc-88e18fedad6803c5f9abdbcf1c4a51c25e12706c.tar.gz
gcc-88e18fedad6803c5f9abdbcf1c4a51c25e12706c.tar.bz2
re PR fortran/40839 (gfortran segmentation fault when a unit number is missing)
PR fortran/40839 * io.c (gfc_resolve_dt): Add LOC argument. Fail if dt->io_unit is NULL. Return FAILURE after issuing error about negative UNIT number. (match_io_element): Don't segfault if current_dt->io_unit is NULL. * gfortran.h (gfc_resolve_dt): Adjust prototype. * resolve.c (resolve_code): Adjust caller. * gfortran.dg/pr40839.f90: New test. From-SVN: r150021
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog10
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/io.c13
-rw-r--r--gcc/fortran/resolve.c2
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/pr40839.f905
6 files changed, 33 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0cdf188..c2d8c9d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2009-07-23 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/40839
+ * io.c (gfc_resolve_dt): Add LOC argument. Fail if
+ dt->io_unit is NULL. Return FAILURE after issuing error about
+ negative UNIT number.
+ (match_io_element): Don't segfault if current_dt->io_unit is NULL.
+ * gfortran.h (gfc_resolve_dt): Adjust prototype.
+ * resolve.c (resolve_code): Adjust caller.
+
2009-07-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40796
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5e3f80f..83c36c5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2637,7 +2637,7 @@ gfc_try gfc_resolve_filepos (gfc_filepos *);
void gfc_free_inquire (gfc_inquire *);
gfc_try gfc_resolve_inquire (gfc_inquire *);
void gfc_free_dt (gfc_dt *);
-gfc_try gfc_resolve_dt (gfc_dt *);
+gfc_try gfc_resolve_dt (gfc_dt *, locus *);
void gfc_free_wait (gfc_wait *);
gfc_try gfc_resolve_wait (gfc_wait *);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index ea56292..76cf619 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2555,7 +2555,7 @@ gfc_free_dt (gfc_dt *dt)
/* Resolve everything in a gfc_dt structure. */
gfc_try
-gfc_resolve_dt (gfc_dt *dt)
+gfc_resolve_dt (gfc_dt *dt, locus *loc)
{
gfc_expr *e;
@@ -2576,6 +2576,12 @@ gfc_resolve_dt (gfc_dt *dt)
RESOLVE_TAG (&tag_e_async, dt->asynchronous);
e = dt->io_unit;
+ if (e == NULL)
+ {
+ gfc_error ("UNIT not specified at %L", loc);
+ return FAILURE;
+ }
+
if (gfc_resolve_expr (e) == SUCCESS
&& (e->ts.type != BT_INTEGER
&& (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
@@ -2635,6 +2641,7 @@ gfc_resolve_dt (gfc_dt *dt)
&& mpz_sgn (e->value.integer) < 0)
{
gfc_error ("UNIT number in statement at %L must be non-negative", &e->where);
+ return FAILURE;
}
if (dt->extra_comma
@@ -2857,6 +2864,7 @@ match_io_element (io_kind k, gfc_code **cpp)
if (gfc_pure (NULL)
&& gfc_impure_variable (expr->symtree->n.sym)
+ && current_dt->io_unit
&& current_dt->io_unit->ts.type == BT_CHARACTER)
{
gfc_error ("Cannot read to variable '%s' in PURE procedure at %C",
@@ -2870,7 +2878,8 @@ match_io_element (io_kind k, gfc_code **cpp)
break;
case M_WRITE:
- if (current_dt->io_unit->ts.type == BT_CHARACTER
+ if (current_dt->io_unit
+ && current_dt->io_unit->ts.type == BT_CHARACTER
&& gfc_pure (NULL)
&& current_dt->io_unit->expr_type == EXPR_VARIABLE
&& gfc_impure_variable (current_dt->io_unit->symtree->n.sym))
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5b4fc2d..376803d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7119,7 +7119,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
case EXEC_READ:
case EXEC_WRITE:
- if (gfc_resolve_dt (code->ext.dt) == FAILURE)
+ if (gfc_resolve_dt (code->ext.dt, &code->loc) == FAILURE)
break;
resolve_branch (code->ext.dt->err, code);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 522ab1a..e9094b5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-07-23 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/40839
+ * gfortran.dg/pr40839.f90: New test.
+
2009-07-23 Michael Matz <matz@suse.de>
PR middle-end/40830
diff --git a/gcc/testsuite/gfortran.dg/pr40839.f90 b/gcc/testsuite/gfortran.dg/pr40839.f90
new file mode 100644
index 0000000..9228529
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr40839.f90
@@ -0,0 +1,5 @@
+! PR fortran/40839
+! { dg-do compile }
+write(fmt='(a)'), 'abc' ! { dg-error "UNIT not specified" }
+write(fmt='()') ! { dg-error "UNIT not specified" }
+end