Patchwork [Fortran] PR fortran/45776: More variable definition checks

login
register
mail settings
Submitter Daniel Kraft
Date Sept. 24, 2010, 4:36 p.m.
Message ID <4C9CD37E.2020602@domob.eu>
Download mbox | patch
Permalink /patch/65661/
State New
Headers show

Comments

Daniel Kraft - Sept. 24, 2010, 4:36 p.m.
Hi,

the attached patch implements the missing IO related variable definition 
checks (which is now PR 45776).  Except the LOCK/UNLOCK cases which can 
not yet be implemented because locks are not yet in gfortran, the full 
list of variable definition contexts of F2008, 16.6.7 should be 
implemented with that.

It fixes some accepts-invalid cases that my last patch created, but also 
adds some checks that were missing before it.  As a bonus, it adds a 
F2008 check when using NEWUNIT (which was missing before).

As I'm not really familiar with the IO related data-structures, I left 
two XXX comments in the patch asking for possible better solutions (when 
they exist), please take a look at them.

Regression testing on GNU/Linux-x86-32.  Ok for trunk if no failures?

Thanks,
Daniel
Daniel Kraft - Sept. 24, 2010, 5:58 p.m.
Daniel Kraft wrote:
> Hi,
> 
> the attached patch implements the missing IO related variable definition 
> checks (which is now PR 45776).  Except the LOCK/UNLOCK cases which can 
> not yet be implemented because locks are not yet in gfortran, the full 
> list of variable definition contexts of F2008, 16.6.7 should be 
> implemented with that.
> 
> It fixes some accepts-invalid cases that my last patch created, but also 
> adds some checks that were missing before it.  As a bonus, it adds a 
> F2008 check when using NEWUNIT (which was missing before).
> 
> As I'm not really familiar with the IO related data-structures, I left 
> two XXX comments in the patch asking for possible better solutions (when 
> they exist), please take a look at them.
> 
> Regression testing on GNU/Linux-x86-32.  Ok for trunk if no failures?

No failures.

Daniel
Jerry DeLisle - Sept. 24, 2010, 7:02 p.m.
On 09/24/2010 09:36 AM, Daniel Kraft wrote:
> Hi,
>
> the attached patch implements the missing IO related variable definition checks
> (which is now PR 45776). Except the LOCK/UNLOCK cases which can not yet be
> implemented because locks are not yet in gfortran, the full list of variable
> definition contexts of F2008, 16.6.7 should be implemented with that.
>
> It fixes some accepts-invalid cases that my last patch created, but also adds
> some checks that were missing before it. As a bonus, it adds a F2008 check when
> using NEWUNIT (which was missing before).
>
> As I'm not really familiar with the IO related data-structures, I left two XXX
> comments in the patch asking for possible better solutions (when they exist),
> please take a look at them.
>

The io_kind is set explicitly at higher level in the matchers.  No need to add the
io_kind transfer_io_kind I think

match
gfc_match_read (void)
{
   return match_io (M_READ);
}


match
gfc_match_write (void)
{
   return match_io (M_WRITE);
}

Also gfc_exec_op in gfc_code has these:

   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,

which are set by the matchers so in resolution you should be able to just test 
for code->op == EXEC_READ for example.

I would prefer you use these structures unless I am missing something.

Cheers,

Jerry
Mikael Morin - Sept. 24, 2010, 7:40 p.m.
On Friday 24 September 2010 21:02:13 Jerry DeLisle wrote:
> On 09/24/2010 09:36 AM, Daniel Kraft wrote:
> > Hi,
> > 
> > the attached patch implements the missing IO related variable definition
> > checks (which is now PR 45776). Except the LOCK/UNLOCK cases which can
> > not yet be implemented because locks are not yet in gfortran, the full
> > list of variable definition contexts of F2008, 16.6.7 should be
> > implemented with that.
> > 
> > It fixes some accepts-invalid cases that my last patch created, but also
> > adds some checks that were missing before it. As a bonus, it adds a
> > F2008 check when using NEWUNIT (which was missing before).
> > 
> > As I'm not really familiar with the IO related data-structures, I left
> > two XXX comments in the patch asking for possible better solutions (when
> > they exist), please take a look at them.
> 
> The io_kind is set explicitly at higher level in the matchers.
Are you sure it is? 

io.c:3671 has:
      /* Save the iokind and locus for later use in resolution.  */
      dt->extra_comma = gfc_get_iokind_expr (&gfc_current_locus, k);

According to the comment, it is non-trivial to get the io kind at resolution 
stage. 

> 
> match
> gfc_match_read (void)
> {
>    return match_io (M_READ);
> }
> 
> 
> match
> gfc_match_write (void)
> {
>    return match_io (M_WRITE);
> }

It seems io_kind (M_READ or M_WRITE) is not saved by match_io in the io 
structures.
By the way, grepping for io_kind reveals that there is a io_kind member in the 
gfc_expr struct only. Having one in gfc_dt (or one of the io structs) instead  
makes more sense. 

This is just my (not so humble) opinion. 

Mikael
Daniel Kraft - Sept. 24, 2010, 8:03 p.m.
Hi Jerry,

thanks for your input!

Jerry DeLisle wrote:
> On 09/24/2010 09:36 AM, Daniel Kraft wrote:
>> Hi,
>>
>> the attached patch implements the missing IO related variable 
>> definition checks
>> (which is now PR 45776). Except the LOCK/UNLOCK cases which can not 
>> yet be
>> implemented because locks are not yet in gfortran, the full list of 
>> variable
>> definition contexts of F2008, 16.6.7 should be implemented with that.
>>
>> It fixes some accepts-invalid cases that my last patch created, but 
>> also adds
>> some checks that were missing before it. As a bonus, it adds a F2008 
>> check when
>> using NEWUNIT (which was missing before).
>>
>> As I'm not really familiar with the IO related data-structures, I left 
>> two XXX
>> comments in the patch asking for possible better solutions (when they 
>> exist),
>> please take a look at them.
>>
> 
> Also gfc_exec_op in gfc_code has these:
> 
>   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
>   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
> 
> which are set by the matchers so in resolution you should be able to 
> just test for code->op == EXEC_READ for example.

I'm aware of these (and use them partially in my patch), but where I add 
the new member to gfc_code the problem is that this is on the 
transfer-statement and there I have EXEC_TRANSFER as op -- so no 
information about whether the transfer is inside a READ or something else.

But IIRC, I have access to the gfc_dt from the transfer, so maybe 
Mikael's suggestion of adding the io_kind to gfc_dt instead would be a 
nicer solution.  If you agree, I'll try to do that instead with my patch.

Yours,
Daniel
Jerry DeLisle - Sept. 24, 2010, 8:30 p.m.
On 09/24/2010 12:40 PM, Mikael Morin wrote:
> On Friday 24 September 2010 21:02:13 Jerry DeLisle wrote:
>> On 09/24/2010 09:36 AM, Daniel Kraft wrote:
>>> Hi,
>>>
>>> the attached patch implements the missing IO related variable definition
>>> checks (which is now PR 45776). Except the LOCK/UNLOCK cases which can
>>> not yet be implemented because locks are not yet in gfortran, the full
>>> list of variable definition contexts of F2008, 16.6.7 should be
>>> implemented with that.
>>>
>>> It fixes some accepts-invalid cases that my last patch created, but also
>>> adds some checks that were missing before it. As a bonus, it adds a
>>> F2008 check when using NEWUNIT (which was missing before).
>>>
>>> As I'm not really familiar with the IO related data-structures, I left
>>> two XXX comments in the patch asking for possible better solutions (when
>>> they exist), please take a look at them.
>>
>> The io_kind is set explicitly at higher level in the matchers.
> Are you sure it is?
>
> io.c:3671 has:
>        /* Save the iokind and locus for later use in resolution.  */
>        dt->extra_comma = gfc_get_iokind_expr (&gfc_current_locus, k);
>
> According to the comment, it is non-trivial to get the io kind at resolution
> stage.
>
>>
>> match
>> gfc_match_read (void)
>> {
>>     return match_io (M_READ);
>> }
>>
>>
>> match
>> gfc_match_write (void)
>> {
>>     return match_io (M_WRITE);
>> }
>
> It seems io_kind (M_READ or M_WRITE) is not saved by match_io in the io
> structures.
> By the way, grepping for io_kind reveals that there is a io_kind member in the
> gfc_expr struct only. Having one in gfc_dt (or one of the io structs) instead
> makes more sense.
>

Ha, I just suggested this very thing to Daniel on IRC before I saw your note 
here (honest). Add to gfc_dt a gfc_expr *dt_io_kind.

(Humble? Whats that?  ;) )

Jerry

Patch

Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 164550)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2111,6 +2111,13 @@  typedef struct gfc_code
     gfc_inquire *inquire;
     gfc_wait *wait;
     gfc_dt *dt;
+
+    /* For transfer, store whether this is reading or writing.  */
+    /* XXX: Can we in some other way determine in resolve_transfer whether
+       we are reading or writing?  Possibly via global variables, but that
+       does not feel right.  */
+    io_kind transfer_io_kind;
+
     gfc_forall_iterator *forall_iterator;
     struct gfc_code *which_construct;
     int stop_code;
@@ -2827,7 +2834,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 *, locus *);
+gfc_try gfc_resolve_dt (gfc_dt *, locus *, gfc_exec_op);
 void gfc_free_wait (gfc_wait *);
 gfc_try gfc_resolve_wait (gfc_wait *);
 
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c	(revision 164549)
+++ gcc/fortran/io.c	(working copy)
@@ -1505,13 +1505,31 @@  resolve_tag (const io_tag *tag, gfc_expr
 	return FAILURE;
     }
 
+  if (tag == &tag_newunit)
+    {
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: NEWUNIT specifier"
+			  " at %L", &e->where) == FAILURE)
+	return FAILURE;
+    }
+
+  /* NEWUNIT, IOSTAT, SIZE and IOMSG are variable definition contexts.  */
+  if (tag == &tag_newunit || tag == &tag_iostat
+      || tag == &tag_size || tag == &tag_iomsg)
+    {
+      char context[64];
+
+      sprintf (context, _("%s tag"), tag->name);
+      if (gfc_check_vardef_context (e, false, context) == FAILURE)
+	return FAILURE;
+    }
+  
   if (tag == &tag_convert)
     {
       if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
 			  &e->where) == FAILURE)
 	return FAILURE;
     }
-  
+
   return SUCCESS;
 }
 
@@ -2716,10 +2734,16 @@  gfc_free_dt (gfc_dt *dt)
 /* Resolve everything in a gfc_dt structure.  */
 
 gfc_try
-gfc_resolve_dt (gfc_dt *dt, locus *loc)
+gfc_resolve_dt (gfc_dt *dt, locus *loc, gfc_exec_op op)
 {
   gfc_expr *e;
 
+  /* XXX: Is there a way to get whether we are READing or WRITing without
+     this new extra argument?  Note that below there is code doing something
+     like that based on extra_comma, but it does not really look like
+     a general method to me.  What if extra_comma is not present?  */
+  gcc_assert (op == EXEC_READ || op == EXEC_WRITE);
+
   RESOLVE_TAG (&tag_format, dt->format_expr);
   RESOLVE_TAG (&tag_rec, dt->rec);
   RESOLVE_TAG (&tag_spos, dt->pos);
@@ -2790,6 +2814,12 @@  gfc_resolve_dt (gfc_dt *dt, locus *loc)
 	  gfc_error ("Internal unit with vector subscript at %L", &e->where);
 	  return FAILURE;
 	}
+
+      /* If we are writing, make sure the internal unit can be changed.  */
+      if (op == EXEC_WRITE
+	  && gfc_check_vardef_context (e, false, _("internal unit in WRITE"))
+	       == FAILURE)
+	return FAILURE;
     }
 
   if (e->rank && e->ts.type != BT_CHARACTER)
@@ -2801,10 +2831,36 @@  gfc_resolve_dt (gfc_dt *dt, locus *loc)
   if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_INTEGER
       && mpz_sgn (e->value.integer) < 0)
     {
-      gfc_error ("UNIT number in statement at %L must be non-negative", &e->where);
+      gfc_error ("UNIT number in statement at %L must be non-negative",
+		 &e->where);
       return FAILURE;
     }
 
+  /* If we are reading and have a namelist, check that all namelist symbols
+     can appear in a variable definition context.  */
+  if (op == EXEC_READ && dt->namelist)
+    {
+      gfc_namelist* n;
+      for (n = dt->namelist->namelist; n; n = n->next)
+	{
+	  gfc_expr* e;
+	  gfc_try t;
+
+	  e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym));
+	  t = gfc_check_vardef_context (e, false, NULL);
+	  gfc_free_expr (e);
+
+	  if (t == FAILURE)
+	    {
+	      gfc_error ("NAMELIST '%s' in READ statement at %L contains"
+			 " the symbol '%s' which may not appear in a"
+			 " variable definition context",
+			 dt->namelist->name, loc, n->sym->name);
+	      return FAILURE;
+	    }
+	}
+    }
+
   if (dt->extra_comma
       && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
 			 "item list at %L", &dt->extra_comma->where) == FAILURE)
@@ -2854,6 +2910,7 @@  gfc_resolve_dt (gfc_dt *dt, locus *loc)
 		 &dt->format_label->where);
       return FAILURE;
     }
+
   return SUCCESS;
 }
 
@@ -3012,50 +3069,8 @@  match_io_element (io_kind k, gfc_code **
 		   io_kind_name (k));
     }
 
-  if (m == MATCH_YES)
-    switch (k)
-      {
-      case M_READ:
-	if (expr->symtree->n.sym->attr.intent == INTENT_IN)
-	  {
-	    gfc_error ("Variable '%s' in input list at %C cannot be "
-		       "INTENT(IN)", expr->symtree->n.sym->name);
-	    m = MATCH_ERROR;
-	  }
-
-	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",
-		       expr->symtree->n.sym->name);
-	    m = MATCH_ERROR;
-	  }
-
-	if (gfc_check_do_variable (expr->symtree))
-	  m = MATCH_ERROR;
-
-	break;
-
-      case M_WRITE:
-	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))
-	  {
-	    gfc_error ("Cannot write to internal file unit '%s' at %C "
-		       "inside a PURE procedure",
-		       current_dt->io_unit->symtree->n.sym->name);
-	    m = MATCH_ERROR;
-	  }
-
-	break;
-
-      default:
-	break;
-      }
+  if (m == MATCH_YES && k == M_READ && gfc_check_do_variable (expr->symtree))
+    m = MATCH_ERROR;
 
   if (m != MATCH_YES)
     {
@@ -3066,6 +3081,7 @@  match_io_element (io_kind k, gfc_code **
   cp = gfc_get_code ();
   cp->op = EXEC_TRANSFER;
   cp->expr1 = expr;
+  cp->ext.transfer_io_kind = k;
 
   *cpp = cp;
   return MATCH_YES;
@@ -3973,41 +3989,54 @@  gfc_resolve_inquire (gfc_inquire *inquir
 {
   RESOLVE_TAG (&tag_unit, inquire->unit);
   RESOLVE_TAG (&tag_file, inquire->file);
-  RESOLVE_TAG (&tag_iomsg, inquire->iomsg);
-  RESOLVE_TAG (&tag_iostat, inquire->iostat);
-  RESOLVE_TAG (&tag_exist, inquire->exist);
-  RESOLVE_TAG (&tag_opened, inquire->opened);
-  RESOLVE_TAG (&tag_number, inquire->number);
-  RESOLVE_TAG (&tag_named, inquire->named);
-  RESOLVE_TAG (&tag_name, inquire->name);
-  RESOLVE_TAG (&tag_s_access, inquire->access);
-  RESOLVE_TAG (&tag_sequential, inquire->sequential);
-  RESOLVE_TAG (&tag_direct, inquire->direct);
-  RESOLVE_TAG (&tag_s_form, inquire->form);
-  RESOLVE_TAG (&tag_formatted, inquire->formatted);
-  RESOLVE_TAG (&tag_unformatted, inquire->unformatted);
-  RESOLVE_TAG (&tag_s_recl, inquire->recl);
-  RESOLVE_TAG (&tag_nextrec, inquire->nextrec);
-  RESOLVE_TAG (&tag_s_blank, inquire->blank);
-  RESOLVE_TAG (&tag_s_position, inquire->position);
-  RESOLVE_TAG (&tag_s_action, inquire->action);
-  RESOLVE_TAG (&tag_read, inquire->read);
-  RESOLVE_TAG (&tag_write, inquire->write);
-  RESOLVE_TAG (&tag_readwrite, inquire->readwrite);
-  RESOLVE_TAG (&tag_s_delim, inquire->delim);
-  RESOLVE_TAG (&tag_s_pad, inquire->pad);
-  RESOLVE_TAG (&tag_s_encoding, inquire->encoding);
-  RESOLVE_TAG (&tag_s_round, inquire->round);
-  RESOLVE_TAG (&tag_iolength, inquire->iolength);
-  RESOLVE_TAG (&tag_convert, inquire->convert);
-  RESOLVE_TAG (&tag_strm_out, inquire->strm_pos);
-  RESOLVE_TAG (&tag_s_async, inquire->asynchronous);
-  RESOLVE_TAG (&tag_s_sign, inquire->sign);
-  RESOLVE_TAG (&tag_s_round, inquire->round);
-  RESOLVE_TAG (&tag_pending, inquire->pending);
-  RESOLVE_TAG (&tag_size, inquire->size);
   RESOLVE_TAG (&tag_id, inquire->id);
 
+  /* For INQUIRE, all tags except FILE, ID and UNIT are variable definition
+     contexts.  Thus, use an extended RESOLVE_TAG macro for that.  */
+#define INQUIRE_RESOLVE_TAG(tag, expr) \
+  RESOLVE_TAG (tag, expr); \
+  if (expr) \
+    { \
+      char context[64]; \
+      sprintf (context, _("%s tag with INQUIRE"), (tag)->name); \
+      if (gfc_check_vardef_context ((expr), false, context) == FAILURE) \
+	return FAILURE; \
+    }
+  INQUIRE_RESOLVE_TAG (&tag_iomsg, inquire->iomsg);
+  INQUIRE_RESOLVE_TAG (&tag_iostat, inquire->iostat);
+  INQUIRE_RESOLVE_TAG (&tag_exist, inquire->exist);
+  INQUIRE_RESOLVE_TAG (&tag_opened, inquire->opened);
+  INQUIRE_RESOLVE_TAG (&tag_number, inquire->number);
+  INQUIRE_RESOLVE_TAG (&tag_named, inquire->named);
+  INQUIRE_RESOLVE_TAG (&tag_name, inquire->name);
+  INQUIRE_RESOLVE_TAG (&tag_s_access, inquire->access);
+  INQUIRE_RESOLVE_TAG (&tag_sequential, inquire->sequential);
+  INQUIRE_RESOLVE_TAG (&tag_direct, inquire->direct);
+  INQUIRE_RESOLVE_TAG (&tag_s_form, inquire->form);
+  INQUIRE_RESOLVE_TAG (&tag_formatted, inquire->formatted);
+  INQUIRE_RESOLVE_TAG (&tag_unformatted, inquire->unformatted);
+  INQUIRE_RESOLVE_TAG (&tag_s_recl, inquire->recl);
+  INQUIRE_RESOLVE_TAG (&tag_nextrec, inquire->nextrec);
+  INQUIRE_RESOLVE_TAG (&tag_s_blank, inquire->blank);
+  INQUIRE_RESOLVE_TAG (&tag_s_position, inquire->position);
+  INQUIRE_RESOLVE_TAG (&tag_s_action, inquire->action);
+  INQUIRE_RESOLVE_TAG (&tag_read, inquire->read);
+  INQUIRE_RESOLVE_TAG (&tag_write, inquire->write);
+  INQUIRE_RESOLVE_TAG (&tag_readwrite, inquire->readwrite);
+  INQUIRE_RESOLVE_TAG (&tag_s_delim, inquire->delim);
+  INQUIRE_RESOLVE_TAG (&tag_s_pad, inquire->pad);
+  INQUIRE_RESOLVE_TAG (&tag_s_encoding, inquire->encoding);
+  INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round);
+  INQUIRE_RESOLVE_TAG (&tag_iolength, inquire->iolength);
+  INQUIRE_RESOLVE_TAG (&tag_convert, inquire->convert);
+  INQUIRE_RESOLVE_TAG (&tag_strm_out, inquire->strm_pos);
+  INQUIRE_RESOLVE_TAG (&tag_s_async, inquire->asynchronous);
+  INQUIRE_RESOLVE_TAG (&tag_s_sign, inquire->sign);
+  INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round);
+  INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending);
+  INQUIRE_RESOLVE_TAG (&tag_size, inquire->size);
+#undef INQUIRE_RESOLVE_TAG
+
   if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
     return FAILURE;
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 164550)
+++ gcc/fortran/resolve.c	(working copy)
@@ -7916,6 +7916,11 @@  resolve_transfer (gfc_code *code)
 		      && exp->expr_type != EXPR_FUNCTION))
     return;
 
+  /* If we are reading, the variable will be changed.  */
+  if (code->ext.transfer_io_kind == M_READ
+      && gfc_check_vardef_context (exp, false, _("item in READ")) == FAILURE)
+    return;
+
   sym = exp->symtree->n.sym;
   ts = &sym->ts;
 
@@ -9059,7 +9064,7 @@  resolve_code (gfc_code *code, gfc_namesp
 
 	case EXEC_READ:
 	case EXEC_WRITE:
-	  if (gfc_resolve_dt (code->ext.dt, &code->loc) == FAILURE)
+	  if (gfc_resolve_dt (code->ext.dt, &code->loc, code->op) == FAILURE)
 	    break;
 
 	  resolve_branch (code->ext.dt->err, code);
Index: gcc/testsuite/gfortran.dg/io_constraints_7.f03
===================================================================
--- gcc/testsuite/gfortran.dg/io_constraints_7.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/io_constraints_7.f03	(revision 0)
@@ -0,0 +1,37 @@ 
+! { dg-do compile }
+
+! PR fortran/45776
+! Variable definition context checks related to IO.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+module m
+  implicit none
+  integer, protected :: a
+  character(len=128), protected :: msg
+end module m
+
+program main
+  use :: m
+  integer :: x
+  logical :: bool
+
+  write (*, iostat=a) 42 ! { dg-error "variable definition context" }
+  write (*, iomsg=msg) 42 ! { dg-error "variable definition context" }
+  read (*, '(I2)', advance='no', size=a) x ! { dg-error "variable definition context" }
+
+  ! These are ok.
+  inquire (unit=a)
+  inquire (file=msg, id=a, pending=bool)
+  inquire (file=msg)
+
+  ! These not, but list is not extensive.
+  inquire (unit=1, number=a) ! { dg-error "variable definition context" }
+  inquire (unit=1, encoding=msg) ! { dg-error "variable definition context" }
+  inquire (unit=1, formatted=msg) ! { dg-error "variable definition context" }
+
+  open (newunit=a, file="foo") ! { dg-error "variable definition context" }
+  close (unit=a)
+end program main
+
+! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/newunit_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/newunit_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/newunit_2.f90	(revision 0)
@@ -0,0 +1,15 @@ 
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR40008 F2008: Add NEWUNIT= for OPEN statement 
+! Check for rejection with pre-F2008 standard.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+program main
+  character(len=25) :: str
+  integer(1) :: myunit
+
+  open (newunit=myunit, file="some_file") ! { dg-error "Fortran 2008" }
+  close (unit=myunit)
+end program main
Index: gcc/testsuite/gfortran.dg/io_constraints_6.f03
===================================================================
--- gcc/testsuite/gfortran.dg/io_constraints_6.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/io_constraints_6.f03	(revision 0)
@@ -0,0 +1,40 @@ 
+! { dg-do compile }
+
+! PR fortran/45776
+! Variable definition context checks related to IO.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+module m
+  implicit none
+
+  integer, protected :: a
+  character(len=128), protected :: str
+end module m
+
+program main
+  use :: m
+  integer, parameter :: b = 42
+  integer :: x
+  character(len=128) :: myStr
+
+  namelist /definable/ x, myStr
+  namelist /undefinable/ x, a
+
+  ! These are invalid.
+  read (myStr, *) a ! { dg-error "variable definition context" }
+  read (myStr, *) x, b ! { dg-error "variable definition context" }
+  write (str, *) 5 ! { dg-error "variable definition context" }
+  read (*, nml=undefinable) ! { dg-error "contains the symbol 'a' which may not" }
+
+  ! These are ok.
+  read (str, *) x
+  write (myStr, *) a
+  write (myStr, *) b
+  print *, a, b
+  write (*, nml=undefinable)
+  read (*, nml=definable)
+  write (*, nml=definable)
+end program main
+
+! { dg-final { cleanup-modules "m" } }