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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150021 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 23 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0cdf188527a..c2d8c9d79d4 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 5e3f80fa822..83c36c5ad85 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 ea562923f05..76cf6199abe 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 5b4fc2d6949..376803d69d9 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);