Patchwork [Fortran] Variable definition context checks

login
register
mail settings
Submitter Daniel Kraft
Date Sept. 22, 2010, 12:10 p.m.
Message ID <4C99F22E.6010403@domob.eu>
Download mbox | patch
Permalink /patch/65419/
State New
Headers show

Comments

Daniel Kraft - Sept. 22, 2010, 12:10 p.m.
Hi all,

the attached patch implements general checks for things, that may/may 
not appear in a "variable definition context" or "pointer association 
context".  Previously, checks that INTENT(IN), PROTECTED or impure 
variables (and other stuff) are not changed, were distributed among a 
number of source files and "duplicated" for all contexts, where a change 
could occur.  This is reworked now so that all checks are done by 
gfc_check_vardef_context and this is called from different places as 
appropriate.

In addition to the refactoring, the patch implements better checks for 
ASSOCIATE names, fixes the remaining bit of PR 44044, implements better 
checks for matching INTENT within procedures (i.e., that INTENT(IN) 
dummies are not passed on to INTENT([IN]OUT)) and also INTENT([IN]OUT) 
checks for intrinsics (which is PR 45474, IIRC).  Finally, there were 
also rejects-valid issues with PROTECTED that are corrected now (see the 
changes in protected_4, protected_6 and protected_7).

Note that this patch does not yet check the full list of variable 
definition contexts as given in the standard (F2008, 16.6.7), missing 
are the LOCK/UNLOCK items as well as the stuff related to IO -- this was 
the minimal set required to make the test-suite pass.  As the patch is 
already quite large, I would like to get this in now since there are no 
test-suite regressions and add the remaining contexts as a follow-up. 
But if you prefer to have the full set at once, I can do this as well. 
All pointer association contexts (F2008, 16.6.8) should be checked, though.

No regressions on GNU/Linux-x86-32.  Ok for trunk?  (If the follow-up is 
ok, I will prepare a ChangeLog for the current patch before check-in.)

Yours,
Daniel
Tobias Burnus - Sept. 22, 2010, 8:06 p.m.
Daniel Kraft wrote:
> the attached patch implements general checks for things, that may/may 
> not appear in a "variable definition context" or "pointer association 
> context". [...]
>
> Note that this patch does not yet check the full list of variable 
> definition contexts as given in the standard (F2008, 16.6.7), missing 
> are the LOCK/UNLOCK items as well as the stuff related to IO -- this 
> was the minimal set required to make the test-suite pass.  [...]  I 
> would like to get this in now [...] and add the remaining contexts as 
> a follow-up.

I am fine with adding the rest add follow up; however, I assume you 
would like to defer the implementation of LOCK/UNLOCK (related to 
coarrays) even further ;-)

> No regressions on GNU/Linux-x86-32.  Ok for trunk?

The patch is OK - with the nits fixed.

+	    gfc_error ("Dummy-argument '%s' with INTENT(IN) in pointer"
+	    gfc_error ("Dummy-argument '%s' with INTENT(IN) in variable"

Any reason for using a hyphen? I would simply use "Dummy argument".


+	    gfc_error ("Associate-name '%s' can not appear in a variable"
+		       " definition context (%s) at %L because it's target"
+		       " at %L can not, either",


I do not like the wording - but I have no better idea. Maybe someone 
else has. At least one should change "it's" to "its".

  * * *

I have to admit I do not like remove_last_array_ref - it feels like a 
hack -, but I fear that handling it in gfc_expr_attr unconditionally 
will break at many places. However, given that gfc_expr_attr is only 
used at 13 places and gfc_variable_attr at 5, wouldn't it make more 
sense to add a Boolean flag? OK with or without that change.

Tobias
Steve Kargl - Sept. 23, 2010, 2:41 a.m.
On Wed, Sep 22, 2010 at 10:06:08PM +0200, Tobias Burnus wrote:
>  Daniel Kraft wrote:
> >the attached patch implements general checks for things, that may/may 
> >not appear in a "variable definition context" or "pointer association 
> >context". [...]
> >
> >Note that this patch does not yet check the full list of variable 
> >definition contexts as given in the standard (F2008, 16.6.7), missing 
> >are the LOCK/UNLOCK items as well as the stuff related to IO -- this 
> >was the minimal set required to make the test-suite pass.  [...]  I 
> >would like to get this in now [...] and add the remaining contexts as 
> >a follow-up.
> 
> +	    gfc_error ("Associate-name '%s' can not appear in a variable"
> +		       " definition context (%s) at %L because it's target"
> +		       " at %L can not, either",
> 
> 
> I do not like the wording - but I have no better idea. Maybe someone 
> else has. At least one should change "it's" to "its".
> 

I agree with Tobias that the wording here could use some help.
Is the error a result of a numbered restriction or constraint?
Perhaps, the text from the standard may be an improvemen.
Daniel Kraft - Sept. 23, 2010, 8:03 a.m.
Steve Kargl wrote:
> On Wed, Sep 22, 2010 at 10:06:08PM +0200, Tobias Burnus wrote:
>>  Daniel Kraft wrote:
>>> the attached patch implements general checks for things, that may/may 
>>> not appear in a "variable definition context" or "pointer association 
>>> context". [...]
>>>
>>> Note that this patch does not yet check the full list of variable 
>>> definition contexts as given in the standard (F2008, 16.6.7), missing 
>>> are the LOCK/UNLOCK items as well as the stuff related to IO -- this 
>>> was the minimal set required to make the test-suite pass.  [...]  I 
>>> would like to get this in now [...] and add the remaining contexts as 
>>> a follow-up.
>> +	    gfc_error ("Associate-name '%s' can not appear in a variable"
>> +		       " definition context (%s) at %L because it's target"
>> +		       " at %L can not, either",
>>
>>
>> I do not like the wording - but I have no better idea. Maybe someone 
>> else has. At least one should change "it's" to "its".
>>
> 
> I agree with Tobias that the wording here could use some help.
> Is the error a result of a numbered restriction or constraint?
> Perhaps, the text from the standard may be an improvemen.

Me too, but I also did not have a better suggestion (but I will of 
course correct the "it's" at the very least).  It is based on item (13) 
of 16.6.7 in F2008, that is:

[contexts, which are variable definition contexts]:

...

(13) a variable that is the selector in a SELECT TYPE or ASSOCIATE 
construct if the associate name of that construct appears in a variable 
definition context;

I do not see how we could use this for a better formulation, but if you 
have an idea, I'd be glad to update the message.

Yours,
Daniel
Daniel Kraft - Sept. 23, 2010, 8:07 a.m.
Hi Tobias,

Tobias Burnus wrote:
>  Daniel Kraft wrote:
>> the attached patch implements general checks for things, that may/may 
>> not appear in a "variable definition context" or "pointer association 
>> context". [...]
>>
>> Note that this patch does not yet check the full list of variable 
>> definition contexts as given in the standard (F2008, 16.6.7), missing 
>> are the LOCK/UNLOCK items as well as the stuff related to IO -- this 
>> was the minimal set required to make the test-suite pass.  [...]  I 
>> would like to get this in now [...] and add the remaining contexts as 
>> a follow-up.
> 
> I am fine with adding the rest add follow up; however, I assume you 
> would like to defer the implementation of LOCK/UNLOCK (related to 
> coarrays) even further ;-)
> 
>> No regressions on GNU/Linux-x86-32.  Ok for trunk?
>
> The patch is OK - with the nits fixed.

thanks for the review!  See my other message with respect to the error 
message.  (For the "Dummy-argument", I'll change that.)

> I have to admit I do not like remove_last_array_ref - it feels like a 
> hack -, but I fear that handling it in gfc_expr_attr unconditionally 
> will break at many places. However, given that gfc_expr_attr is only 
> used at 13 places and gfc_variable_attr at 5, wouldn't it make more 
> sense to add a Boolean flag? OK with or without that change.

I see what you mean and thought about this myself -- but in some sense I 
like my current "hack" better than adding a boolean flag (no matter in 
how many/few places that would need changes -- besides, I would have to 
add this flag to gfc_check_vardef_context also, so it can pass it on to 
gfc_expr_attr as required).  The reason is that for something like

ALLOCATE (arr(5))

I see the real expression, that appears in a variable definition 
context, to be "arr" and not "arr(5)".  The reference is just an extra 
information that "misuses" the syntax and gfortran-parser for array 
references.  So at least from a theoretical point of view, I think 
stripping this information off to get the "real" expression is the 
"correct" solution.  What do you think?  But if you want, I can of 
course change that to a flag (or I can also try handling this 
unconditionally in gfc_expr_attr and see what this does).

Yours,
Daniel
Daniel Kraft - Sept. 23, 2010, 8:44 a.m.
Tobias Burnus wrote:
>  Daniel Kraft wrote:
>> the attached patch implements general checks for things, that may/may 
>> not appear in a "variable definition context" or "pointer association 
>> context". [...]
>>
>> Note that this patch does not yet check the full list of variable 
>> definition contexts as given in the standard (F2008, 16.6.7), missing 
>> are the LOCK/UNLOCK items as well as the stuff related to IO -- this 
>> was the minimal set required to make the test-suite pass.  [...]  I 
>> would like to get this in now [...] and add the remaining contexts as 
>> a follow-up.
> 
> I am fine with adding the rest add follow up; however, I assume you 
> would like to defer the implementation of LOCK/UNLOCK (related to 
> coarrays) even further ;-)
> 
>> No regressions on GNU/Linux-x86-32.  Ok for trunk?
> 
> The patch is OK - with the nits fixed.

Committed rev. 164550, with updated error messages and as discussed on 
IRC.  I will now work on the missing contexts.

Daniel

Patch

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 164495)
+++ gcc/fortran/interface.c	(working copy)
@@ -1655,36 +1655,6 @@  compare_parameter (gfc_symbol *formal, g
 }
 
 
-/* Given a symbol of a formal argument list and an expression, see if
-   the two are compatible as arguments.  Returns nonzero if
-   compatible, zero if not compatible.  */
-
-static int
-compare_parameter_protected (gfc_symbol *formal, gfc_expr *actual)
-{
-  if (actual->expr_type != EXPR_VARIABLE)
-    return 1;
-
-  if (!actual->symtree->n.sym->attr.is_protected)
-    return 1;
-
-  if (!actual->symtree->n.sym->attr.use_assoc)
-    return 1;
-
-  if (formal->attr.intent == INTENT_IN
-      || formal->attr.intent == INTENT_UNKNOWN)
-    return 1;
-
-  if (!actual->symtree->n.sym->attr.pointer)
-    return 0;
-
-  if (actual->symtree->n.sym->attr.pointer && formal->attr.pointer)
-    return 0;
-
-  return 1;
-}
-
-
 /* Returns the storage size of a symbol (formal argument) or
    zero if it cannot be determined.  */
 
@@ -2205,27 +2175,20 @@  compare_actual_formal (gfc_actual_arglis
 	}
 
       /* Check intent = OUT/INOUT for definable actual argument.  */
-      if ((a->expr->expr_type != EXPR_VARIABLE
-	   || (a->expr->symtree->n.sym->attr.flavor != FL_VARIABLE
-	       && a->expr->symtree->n.sym->attr.flavor != FL_PROCEDURE))
-	  && (f->sym->attr.intent == INTENT_OUT
-	      || f->sym->attr.intent == INTENT_INOUT))
-	{
-	  if (where)
-	    gfc_error ("Actual argument at %L must be definable as "
-		       "the dummy argument '%s' is INTENT = OUT/INOUT",
-		       &a->expr->where, f->sym->name);
-	  return 0;
-	}
-
-      if (!compare_parameter_protected(f->sym, a->expr))
+      if ((f->sym->attr.intent == INTENT_OUT
+	  || f->sym->attr.intent == INTENT_INOUT))
 	{
-	  if (where)
-	    gfc_error ("Actual argument at %L is use-associated with "
-		       "PROTECTED attribute and dummy argument '%s' is "
-		       "INTENT = OUT/INOUT",
-		       &a->expr->where,f->sym->name);
-	  return 0;
+	  const char* context = (where
+				 ? _("actual argument to INTENT = OUT/INOUT")
+				 : NULL);
+
+	  if (f->sym->attr.pointer
+	      && gfc_check_vardef_context (a->expr, true, context)
+		   == FAILURE)
+	    return 0;
+	  if (gfc_check_vardef_context (a->expr, false, context)
+		== FAILURE)
+	    return 0;
 	}
 
       if ((f->sym->attr.intent == INTENT_OUT
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 164495)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -3585,6 +3585,19 @@  check_arglist (gfc_actual_arglist **ap, 
 		       gfc_typename (&actual->expr->ts));
 	  return FAILURE;
 	}
+
+      /* If the formal argument is INTENT([IN]OUT), check for definability.  */
+      if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
+	{
+	  const char* context = (error_flag
+				 ? _("actual argument to INTENT = OUT/INOUT")
+				 : NULL);
+
+	  /* No pointer arguments for intrinsics.  */
+	  if (gfc_check_vardef_context (actual->expr, false, context)
+		== FAILURE)
+	    return FAILURE;
+	}
     }
 
   return SUCCESS;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 164495)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -784,6 +784,9 @@  typedef struct
   unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
 	   private_comp:1, zero_comp:1, coarray_comp:1;
 
+  /* This is a temporary selector for SELECT TYPE.  */
+  unsigned select_type_temporary:1;
+
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
@@ -2726,6 +2729,7 @@  bool gfc_has_ultimate_allocatable (gfc_e
 bool gfc_has_ultimate_pointer (gfc_expr *);
 
 gfc_expr* gfc_build_intrinsic_call (const char*, locus, unsigned, ...);
+gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*);
 
 
 /* st.c */
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 164495)
+++ gcc/fortran/expr.c	(working copy)
@@ -3043,10 +3043,8 @@  gfc_check_assign (gfc_expr *lvalue, gfc_
 
   sym = lvalue->symtree->n.sym;
 
-  /* Check INTENT(IN), unless the object itself is the component or
-     sub-component of a pointer.  */
+  /* See if this is the component or subcomponent of a pointer.  */
   has_pointer = sym->attr.pointer;
-
   for (ref = lvalue->ref; ref; ref = ref->next)
     if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
       {
@@ -3054,13 +3052,6 @@  gfc_check_assign (gfc_expr *lvalue, gfc_
 	break;
       }
 
-  if (!has_pointer && sym->attr.intent == INTENT_IN)
-    {
-      gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L",
-		 sym->name, &lvalue->where);
-      return FAILURE;
-    }
-
   /* 12.5.2.2, Note 12.26: The result variable is very similar to any other
      variable local to a function subprogram.  Its existence begins when
      execution of the function is initiated and ends when execution of the
@@ -3239,7 +3230,7 @@  gfc_check_pointer_assign (gfc_expr *lval
   symbol_attribute attr;
   gfc_ref *ref;
   bool is_pure, rank_remap;
-  int pointer, check_intent_in, proc_pointer;
+  int proc_pointer;
 
   if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN
       && !lvalue->symtree->n.sym->attr.proc_pointer)
@@ -3259,24 +3250,13 @@  gfc_check_pointer_assign (gfc_expr *lval
       return FAILURE;
     }
 
-
-  /* Check INTENT(IN), unless the object itself is the component or
-     sub-component of a pointer.  */
-  check_intent_in = 1;
-  pointer = lvalue->symtree->n.sym->attr.pointer;
   proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer;
 
   rank_remap = false;
   for (ref = lvalue->ref; ref; ref = ref->next)
     {
-      if (pointer)
-	check_intent_in = 0;
-
       if (ref->type == REF_COMPONENT)
-	{
-	  pointer = ref->u.c.component->attr.pointer;
-	  proc_pointer = ref->u.c.component->attr.proc_pointer;
-	}
+	proc_pointer = ref->u.c.component->attr.proc_pointer;
 
       if (ref->type == REF_ARRAY && ref->next == NULL)
 	{
@@ -3332,30 +3312,8 @@  gfc_check_pointer_assign (gfc_expr *lval
 	}
     }
 
-  if (check_intent_in && lvalue->symtree->n.sym->attr.intent == INTENT_IN)
-    {
-      gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L",
-		 lvalue->symtree->n.sym->name, &lvalue->where);
-      return FAILURE;
-    }
-
-  if (!pointer && !proc_pointer
-      && !(lvalue->ts.type == BT_CLASS
-	   && CLASS_DATA (lvalue)->attr.class_pointer))
-    {
-      gfc_error ("Pointer assignment to non-POINTER at %L", &lvalue->where);
-      return FAILURE;
-    }
-
   is_pure = gfc_pure (NULL);
 
-  if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym)
-	&& lvalue->symtree->n.sym->value != rvalue)
-    {
-      gfc_error ("Bad pointer object in PURE procedure at %L", &lvalue->where);
-      return FAILURE;
-    }
-
   /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type,
      kind, etc for lvalue and rvalue must match, and rvalue must be a
      pure variable if we're in a pure function.  */
@@ -4338,3 +4296,188 @@  gfc_build_intrinsic_call (const char* na
 
   return result;
 }
+
+
+/* Check if an expression may appear in a variable definition context
+   (F2008, 16.6.7) or pointer association context (F2008, 16.6.8).
+   This is called from the various places when resolving
+   the pieces that make up such a context.
+
+   Optionally, a possible error message can be suppressed if context is NULL
+   and just the return status (SUCCESS / FAILURE) be requested.  */
+
+gfc_try
+gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context)
+{
+  gfc_symbol* sym;
+  bool is_pointer;
+  bool check_intentin;
+  bool ptr_component;
+  symbol_attribute attr;
+  gfc_ref* ref;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    {
+      if (context)
+	gfc_error ("Non-variable expression in variable definition context (%s)"
+		   " at %L", context, &e->where);
+      return FAILURE;
+    }
+
+  gcc_assert (e->symtree);
+  sym = e->symtree->n.sym;
+
+  if (!pointer && sym->attr.flavor == FL_PARAMETER)
+    {
+      if (context)
+	gfc_error ("Named constant '%s' in variable definition context (%s)"
+		   " at %L", sym->name, context, &e->where);
+      return FAILURE;
+    }
+  if (!pointer && sym->attr.flavor != FL_VARIABLE
+      && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
+      && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
+    {
+      if (context)
+	gfc_error ("'%s' in variable definition context (%s) at %L is not"
+		   " a variable", sym->name, context, &e->where);
+      return FAILURE;
+    }
+
+  /* Find out whether the expr is a pointer; this also means following
+     component references to the last one.  */
+  attr = gfc_expr_attr (e);
+  is_pointer = (attr.pointer || attr.proc_pointer);
+  if (pointer && !is_pointer)
+    {
+      if (context)
+	gfc_error ("Non-POINTER in pointer association context (%s)"
+		   " at %L", context, &e->where);
+      return FAILURE;
+    }
+
+  /* INTENT(IN) dummy argument.  Check this, unless the object itself is
+     the component of sub-component of a pointer.  Obviously,
+     procedure pointers are of no interest here.  */
+  check_intentin = true;
+  ptr_component = sym->attr.pointer;
+  for (ref = e->ref; ref && check_intentin; ref = ref->next)
+    {
+      if (ptr_component && ref->type == REF_COMPONENT)
+	check_intentin = false;
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+	ptr_component = true;
+    }
+  if (check_intentin && sym->attr.intent == INTENT_IN)
+    {
+      if (pointer && is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Dummy-argument '%s' with INTENT(IN) in pointer"
+		       " association context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+      if (!pointer && !is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Dummy-argument '%s' with INTENT(IN) in variable"
+		       " definition context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+    }
+
+  /* PROTECTED and use-associated.  */
+  if (sym->attr.is_protected && sym->attr.use_assoc)
+    {
+      if (pointer && is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+		       " pointer association context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+      if (!pointer && !is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+		       " variable definition context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+    }
+
+  /* Variable not assignable from a PURE procedure but appears in
+     variable definition context.  */
+  if (!pointer && gfc_pure (NULL) && gfc_impure_variable (sym))
+    {
+      if (context)
+	gfc_error ("Variable '%s' can not appear in a variable definition"
+		   " context (%s) at %L in PURE procedure",
+		   sym->name, context, &e->where);
+      return FAILURE;
+    }
+
+  /* Check variable definition context for associate-names.  */
+  if (!pointer && sym->assoc)
+    {
+      const char* name;
+      gfc_association_list* assoc;
+
+      gcc_assert (sym->assoc->target);
+
+      /* If this is a SELECT TYPE temporary (the association is used internally
+	 for SELECT TYPE), silently go over to the target.  */
+      if (sym->attr.select_type_temporary)
+	{
+	  gfc_expr* t = sym->assoc->target;
+
+	  gcc_assert (t->expr_type == EXPR_VARIABLE);
+	  name = t->symtree->name;
+
+	  if (t->symtree->n.sym->assoc)
+	    assoc = t->symtree->n.sym->assoc;
+	  else
+	    assoc = sym->assoc;
+	}
+      else
+	{
+	  name = sym->name;
+	  assoc = sym->assoc;
+	}
+      gcc_assert (name && assoc);
+
+      /* Is association to a valid variable?  */
+      if (!assoc->variable)
+	{
+	  if (context)
+	    {
+	      if (assoc->target->expr_type == EXPR_VARIABLE)
+		gfc_error ("'%s' at %L associated to vector-indexed target can"
+			   " not be used in a variable definition context (%s)",
+			   name, &e->where, context);
+	      else
+		gfc_error ("'%s' at %L associated to expression can"
+			   " not be used in a variable definition context (%s)",
+			   name, &e->where, context);
+	    }
+	  return FAILURE;
+	}
+
+      /* Target must be allowed to appear in a variable definition context.  */
+      if (gfc_check_vardef_context (assoc->target, pointer, NULL) == FAILURE)
+	{
+	  if (context)
+	    gfc_error ("Associate-name '%s' can not appear in a variable"
+		       " definition context (%s) at %L because it's target"
+		       " at %L can not, either",
+		       name, context, &e->where,
+		       &assoc->target->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 164495)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2859,8 +2859,6 @@  gfc_iso_c_func_interface (gfc_symbol *sy
 
 /* Resolve a function call, which means resolving the arguments, then figuring
    out which entity the name refers to.  */
-/* TODO: Check procedure arguments so that an INTENT(IN) isn't passed
-   to INTENT(OUT) or INTENT(INOUT).  */
 
 static gfc_try
 resolve_function (gfc_expr *expr)
@@ -6131,12 +6129,9 @@  gfc_resolve_iterator (gfc_iterator *iter
       == FAILURE)
     return FAILURE;
 
-  if (gfc_pure (NULL) && gfc_impure_variable (iter->var->symtree->n.sym))
-    {
-      gfc_error ("Cannot assign to loop variable in PURE procedure at %L",
-		 &iter->var->where);
-      return FAILURE;
-    }
+  if (gfc_check_vardef_context (iter->var, false, _("iterator variable"))
+      == FAILURE)
+    return FAILURE;
 
   if (gfc_resolve_iterator_expr (iter->start, real_ok,
 				 "Start expression in DO loop") == FAILURE)
@@ -6331,14 +6326,11 @@  static gfc_try
 resolve_deallocate_expr (gfc_expr *e)
 {
   symbol_attribute attr;
-  int allocatable, pointer, check_intent_in;
+  int allocatable, pointer;
   gfc_ref *ref;
   gfc_symbol *sym;
   gfc_component *c;
 
-  /* Check INTENT(IN), unless the object is a sub-component of a pointer.  */
-  check_intent_in = 1;
-
   if (gfc_resolve_expr (e) == FAILURE)
     return FAILURE;
 
@@ -6359,9 +6351,6 @@  resolve_deallocate_expr (gfc_expr *e)
     }
   for (ref = e->ref; ref; ref = ref->next)
     {
-      if (pointer)
-	check_intent_in = 0;
-
       switch (ref->type)
 	{
 	case REF_ARRAY:
@@ -6399,12 +6388,11 @@  resolve_deallocate_expr (gfc_expr *e)
       return FAILURE;
     }
 
-  if (check_intent_in && sym->attr.intent == INTENT_IN)
-    {
-      gfc_error ("Cannot deallocate INTENT(IN) variable '%s' at %L",
-		 sym->name, &e->where);
-      return FAILURE;
-    }
+  if (pointer
+      && gfc_check_vardef_context (e, true, _("DEALLOCATE object")) == FAILURE)
+    return FAILURE;
+  if (gfc_check_vardef_context (e, false, _("DEALLOCATE object")) == FAILURE)
+    return FAILURE;
 
   if (e->ts.type == BT_CLASS)
     {
@@ -6464,6 +6452,31 @@  gfc_expr_to_initialize (gfc_expr *e)
 }
 
 
+/* If the last ref of an expression is an array ref, return a copy of the
+   expression with that one removed.  Otherwise, a copy of the original
+   expression.  This is used for allocate-expressions and pointer assignment
+   LHS, where there may be an array specification that needs to be stripped
+   off when using gfc_check_vardef_context.  */
+
+static gfc_expr*
+remove_last_array_ref (gfc_expr* e)
+{
+  gfc_expr* e2;
+  gfc_ref** r;
+
+  e2 = gfc_copy_expr (e);
+  for (r = &e2->ref; *r; r = &(*r)->next)
+    if ((*r)->type == REF_ARRAY && !(*r)->next)
+      {
+	gfc_free_ref_list (*r);
+	*r = NULL;
+	break;
+      }
+
+  return e2;
+}
+
+
 /* Used in resolve_allocate_expr to check that a allocation-object and
    a source-expr are conformable.  This does not catch all possible 
    cases; in particular a runtime checking is needed.  */
@@ -6526,17 +6539,16 @@  conformable_arrays (gfc_expr *e1, gfc_ex
 static gfc_try
 resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 {
-  int i, pointer, allocatable, dimension, check_intent_in, is_abstract;
+  int i, pointer, allocatable, dimension, is_abstract;
   int codimension;
   symbol_attribute attr;
   gfc_ref *ref, *ref2;
+  gfc_expr *e2;
   gfc_array_ref *ar;
   gfc_symbol *sym = NULL;
   gfc_alloc *a;
   gfc_component *c;
-
-  /* Check INTENT(IN), unless the object is a sub-component of a pointer.  */
-  check_intent_in = 1;
+  gfc_try t;
 
   /* Mark the ultimost array component as being in allocate to allow DIMEN_STAR
      checking of coarrays.  */
@@ -6588,9 +6600,6 @@  resolve_allocate_expr (gfc_expr *e, gfc_
 
       for (ref = e->ref; ref; ref2 = ref, ref = ref->next)
 	{
-	  if (pointer)
-	    check_intent_in = 0;
-
 	  switch (ref->type)
 	    {
  	      case REF_ARRAY:
@@ -6677,12 +6686,18 @@  resolve_allocate_expr (gfc_expr *e, gfc_
       goto failure;
     }
 
-  if (check_intent_in && sym->attr.intent == INTENT_IN)
-    {
-      gfc_error ("Cannot allocate INTENT(IN) variable '%s' at %L",
-		 sym->name, &e->where);
-      goto failure;
-    }
+  /* In the variable definition context checks, gfc_expr_attr is used
+     on the expression.  This is fooled by the array specification
+     present in e, thus we have to eliminate that one temporarily.  */
+  e2 = remove_last_array_ref (e);
+  t = SUCCESS;
+  if (t == SUCCESS && pointer)
+    t = gfc_check_vardef_context (e2, true, _("ALLOCATE object"));
+  if (t == SUCCESS)
+    t = gfc_check_vardef_context (e2, false, _("ALLOCATE object"));
+  gfc_free_expr (e2);
+  if (t == FAILURE)
+    goto failure;
 
   if (!code->expr3)
     {
@@ -6733,9 +6748,9 @@  resolve_allocate_expr (gfc_expr *e, gfc_
   if (pointer || (dimension == 0 && codimension == 0))
     goto success;
 
-  /* Make sure the next-to-last reference node is an array specification.  */
+  /* Make sure the last reference node is an array specifiction.  */
 
-  if (ref2 == NULL || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
+  if (!ref2 || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
       || (dimension && ref2->u.ar.dimen == 0))
     {
       gfc_error ("Array specification required in ALLOCATE statement "
@@ -6846,20 +6861,13 @@  resolve_allocate_deallocate (gfc_code *c
   gfc_expr *stat, *errmsg, *pe, *qe;
   gfc_alloc *a, *p, *q;
 
-  stat = code->expr1 ? code->expr1 : NULL;
-
-  errmsg = code->expr2 ? code->expr2 : NULL;
+  stat = code->expr1;
+  errmsg = code->expr2;
 
   /* Check the stat variable.  */
   if (stat)
     {
-      if (stat->symtree->n.sym->attr.intent == INTENT_IN)
-	gfc_error ("Stat-variable '%s' at %L cannot be INTENT(IN)",
-		   stat->symtree->n.sym->name, &stat->where);
-
-      if (gfc_pure (NULL) && gfc_impure_variable (stat->symtree->n.sym))
-	gfc_error ("Illegal stat-variable at %L for a PURE procedure",
-		   &stat->where);
+      gfc_check_vardef_context (stat, false, _("STAT variable"));
 
       if ((stat->ts.type != BT_INTEGER
 	   && !(stat->ref && (stat->ref->type == REF_ARRAY
@@ -6902,13 +6910,7 @@  resolve_allocate_deallocate (gfc_code *c
 	gfc_warning ("ERRMSG at %L is useless without a STAT tag",
 		     &errmsg->where);
 
-      if (errmsg->symtree->n.sym->attr.intent == INTENT_IN)
-	gfc_error ("Errmsg-variable '%s' at %L cannot be INTENT(IN)",
-		   errmsg->symtree->n.sym->name, &errmsg->where);
-
-      if (gfc_pure (NULL) && gfc_impure_variable (errmsg->symtree->n.sym))
-	gfc_error ("Illegal errmsg-variable at %L for a PURE procedure",
-		   &errmsg->where);
+      gfc_check_vardef_context (errmsg, false, _("ERRMSG variable"));
 
       if ((errmsg->ts.type != BT_CHARACTER
 	   && !(errmsg->ref
@@ -7539,7 +7541,6 @@  static void
 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 {
   gfc_expr* target;
-  bool to_var;
 
   gcc_assert (sym->assoc);
   gcc_assert (sym->attr.flavor == FL_VARIABLE);
@@ -7573,22 +7574,8 @@  resolve_assoc_var (gfc_symbol* sym, bool
   gcc_assert (sym->ts.type != BT_UNKNOWN);
 
   /* See if this is a valid association-to-variable.  */
-  to_var = (target->expr_type == EXPR_VARIABLE
-	    && !gfc_has_vector_subscript (target));
-  if (sym->assoc->variable && !to_var)
-    {
-      if (target->expr_type == EXPR_VARIABLE)
-	gfc_error ("'%s' at %L associated to vector-indexed target can not"
-		   " be used in a variable definition context",
-		   sym->name, &sym->declared_at);
-      else
-	gfc_error ("'%s' at %L associated to expression can not"
-		   " be used in a variable definition context",
-		   sym->name, &sym->declared_at);
-
-      return;
-    }
-  sym->assoc->variable = to_var;
+  sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
+			  && !gfc_has_vector_subscript (target));
 
   /* Finally resolve if this is an array or not.  */
   if (sym->attr.dimension && target->rank == 0)
@@ -7617,7 +7604,7 @@  resolve_assoc_var (gfc_symbol* sym, bool
 /* Resolve a SELECT TYPE statement.  */
 
 static void
-resolve_select_type (gfc_code *code)
+resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 {
   gfc_symbol *selector_type;
   gfc_code *body, *new_st, *if_st, *tail;
@@ -7895,8 +7882,13 @@  resolve_select_type (gfc_code *code)
 	default_case->next = if_st;
     }
 
-  resolve_select (code);
+  /* Resolve the internal code.  This can not be done earlier because
+     it requires that the sym->assoc of selectors is set already.  */
+  gfc_current_ns = ns;
+  gfc_resolve_blocks (code->block, gfc_current_ns);
+  gfc_current_ns = old_ns;
 
+  resolve_select (code);
 }
 
 
@@ -8657,7 +8649,6 @@  resolve_ordinary_assign (gfc_code *code,
 	}
     }
 
-
   if (lhs->ts.type == BT_CHARACTER
 	&& gfc_option.warn_character_truncation)
     {
@@ -8698,15 +8689,6 @@  resolve_ordinary_assign (gfc_code *code,
 
   if (gfc_pure (NULL))
     {
-      if (gfc_impure_variable (lhs->symtree->n.sym))
-	{
-	  gfc_error ("Cannot assign to variable '%s' in PURE "
-		     "procedure at %L",
-		      lhs->symtree->n.sym->name,
-		      &lhs->where);
-	  return rval;
-	}
-
       if (lhs->ts.type == BT_DERIVED
 	    && lhs->expr_type == EXPR_VARIABLE
 	    && lhs->ts.u.derived->attr.pointer_comp
@@ -8810,9 +8792,8 @@  resolve_code (gfc_code *code, gfc_namesp
 	      gfc_resolve_omp_do_blocks (code, ns);
 	      break;
 	    case EXEC_SELECT_TYPE:
-	      gfc_current_ns = code->ext.block.ns;
-	      gfc_resolve_blocks (code->block, gfc_current_ns);
-	      gfc_current_ns = ns;
+	      /* Blocks are handled in resolve_select_type because we have
+		 to transform the SELECT TYPE into ASSOCIATE first.  */
 	      break;
 	    case EXEC_OMP_WORKSHARE:
 	      omp_workshare_save = omp_workshare_flag;
@@ -8899,6 +8880,10 @@  resolve_code (gfc_code *code, gfc_namesp
 	  if (t == FAILURE)
 	    break;
 
+	  if (gfc_check_vardef_context (code->expr1, false, _("assignment"))
+		== FAILURE)
+	    break;
+
 	  if (resolve_ordinary_assign (code, ns))
 	    {
 	      if (code->op == EXEC_COMPCALL)
@@ -8923,11 +8908,27 @@  resolve_code (gfc_code *code, gfc_namesp
 	  break;
 
 	case EXEC_POINTER_ASSIGN:
-	  if (t == FAILURE)
-	    break;
+	  {
+	    gfc_expr* e;
 
-	  gfc_check_pointer_assign (code->expr1, code->expr2);
-	  break;
+	    if (t == FAILURE)
+	      break;
+
+	    /* This is both a variable definition and pointer assignment
+	       context, so check both of them.  For rank remapping, a final
+	       array ref may be present on the LHS and fool gfc_expr_attr
+	       used in gfc_check_vardef_context.  Remove it.  */
+	    e = remove_last_array_ref (code->expr1);
+	    t = gfc_check_vardef_context (e, true, _("pointer assignment"));
+	    if (t == SUCCESS)
+	      t = gfc_check_vardef_context (e, false, _("pointer assignment"));
+	    gfc_free_expr (e);
+	    if (t == FAILURE)
+	      break;
+
+	    gfc_check_pointer_assign (code->expr1, code->expr2);
+	    break;
+	  }
 
 	case EXEC_ARITHMETIC_IF:
 	  if (t == SUCCESS
@@ -8970,7 +8971,7 @@  resolve_code (gfc_code *code, gfc_namesp
 	  break;
 
 	case EXEC_SELECT_TYPE:
-	  resolve_select_type (code);
+	  resolve_select_type (code, ns);
 	  break;
 
 	case EXEC_BLOCK:
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 164495)
+++ gcc/fortran/match.c	(working copy)
@@ -978,13 +978,6 @@  gfc_match_iterator (gfc_iterator *iter, 
       goto cleanup;
     }
 
-  if (var->symtree->n.sym->attr.intent == INTENT_IN)
-    {
-      gfc_error ("Loop variable '%s' at %C cannot be INTENT(IN)",
-		 var->symtree->n.sym->name);
-      goto cleanup;
-    }
-
   gfc_match_char ('=');
 
   var->symtree->n.sym->attr.implied_index = 1;
@@ -1847,9 +1840,7 @@  gfc_match_associate (void)
 
       /* The `variable' field is left blank for now; because the target is not
 	 yet resolved, we can't use gfc_has_vector_subscript to determine it
-	 for now.  Instead, if the symbol is matched as variable, this field
-	 is set -- and during resolution we check that.  */
-      newAssoc->variable = 0;
+	 for now.  This is set during resolution.  */
 
       /* Put it into the list.  */
       newAssoc->next = new_st.ext.block.assoc;
@@ -3166,12 +3157,6 @@  gfc_match_nullify (void)
       if (gfc_check_do_variable (p->symtree))
 	goto cleanup;
 
-      if (gfc_pure (NULL) && gfc_impure_variable (p->symtree->n.sym))
-	{
-	  gfc_error ("Illegal variable in NULLIFY at %C for a PURE procedure");
-	  goto cleanup;
-	}
-
       /* build ' => NULL() '.  */
       e = gfc_get_null_expr (&gfc_current_locus);
 
@@ -4523,6 +4508,7 @@  select_type_set_tmp (gfc_typespec *ts)
 			      &tmp->n.sym->as, false);
       tmp->n.sym->attr.class_ok = 1;
     }
+  tmp->n.sym->attr.select_type_temporary = 1;
 
   /* Add an association for it, so the rest of the parser knows it is
      an associate-name.  The target will be set during resolution.  */
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 164495)
+++ gcc/fortran/primary.c	(working copy)
@@ -2007,7 +2007,6 @@  gfc_variable_attr (gfc_expr *expr, gfc_t
   if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
     gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");
 
-  ref = expr->ref;
   sym = expr->symtree->n.sym;
   attr = sym->attr;
 
@@ -2031,7 +2030,7 @@  gfc_variable_attr (gfc_expr *expr, gfc_t
   if (ts != NULL && expr->ts.type == BT_UNKNOWN)
     *ts = sym->ts;
 
-  for (; ref; ref = ref->next)
+  for (ref = expr->ref; ref; ref = ref->next)
     switch (ref->type)
       {
       case REF_ARRAY:
@@ -2986,13 +2985,7 @@  match_variable (gfc_expr **result, int e
   switch (sym->attr.flavor)
     {
     case FL_VARIABLE:
-      if (sym->attr.is_protected && sym->attr.use_assoc)
-	{
-	  gfc_error ("Assigning to PROTECTED variable at %C");
-	  return MATCH_ERROR;
-	}
-      if (sym->assoc)
-	sym->assoc->variable = 1;
+      /* Everything is alright.  */
       break;
 
     case FL_UNKNOWN:
@@ -3024,22 +3017,24 @@  match_variable (gfc_expr **result, int e
 
     case FL_PARAMETER:
       if (equiv_flag)
-	gfc_error ("Named constant at %C in an EQUIVALENCE");
-      else
-	gfc_error ("Cannot assign to a named constant at %C");
-      return MATCH_ERROR;
+	{
+	  gfc_error ("Named constant at %C in an EQUIVALENCE");
+	  return MATCH_ERROR;
+	}
+      /* Otherwise this is checked for and an error given in the
+	 variable definition context checks.  */
       break;
 
     case FL_PROCEDURE:
       /* Check for a nonrecursive function result variable.  */
       if (sym->attr.function
-          && !sym->attr.external
-          && sym->result == sym
-          && (gfc_is_function_return_value (sym, gfc_current_ns)
-              || (sym->attr.entry
-                  && sym->ns == gfc_current_ns)
-              || (sym->attr.entry
-                  && sym->ns == gfc_current_ns->parent)))
+	  && !sym->attr.external
+	  && sym->result == sym
+	  && (gfc_is_function_return_value (sym, gfc_current_ns)
+	      || (sym->attr.entry
+		  && sym->ns == gfc_current_ns)
+	      || (sym->attr.entry
+		  && sym->ns == gfc_current_ns->parent)))
 	{
 	  /* If a function result is a derived type, then the derived
 	     type may still have to be resolved.  */
Index: gcc/testsuite/gfortran.dg/associate_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_5.f03	(revision 164495)
+++ gcc/testsuite/gfortran.dg/associate_5.f03	(working copy)
@@ -18,9 +18,26 @@  PROGRAM main
     ptr => a ! { dg-error "neither TARGET nor POINTER" }
   END ASSOCIATE
 
-  ASSOCIATE (a => 5, & ! { dg-error "variable definition context" }
-             b => arr((/ 1, 3 /))) ! { dg-error "variable definition context" }
-    a = 4
-    b = 7
+  ASSOCIATE (a => 5, b => arr((/ 1, 3 /)))
+    a = 4 ! { dg-error "variable definition context" }
+    b = 7 ! { dg-error "variable definition context" }
+    CALL test2 (a) ! { dg-error "variable definition context" }
+    CALL test2 (b) ! { dg-error "variable definition context" }
   END ASSOCIATE
+
+CONTAINS
+
+  SUBROUTINE test (x)
+    INTEGER, INTENT(IN) :: x
+    ASSOCIATE (y => x) ! { dg-error "variable definition context" }
+      y = 5 ! { dg-error "variable definition context" }
+      CALL test2 (x) ! { dg-error "variable definition context" }
+    END ASSOCIATE
+  END SUBROUTINE test
+
+  ELEMENTAL SUBROUTINE test2 (x)
+    INTEGER, INTENT(OUT) :: x
+    x = 5
+  END SUBROUTINE test2
+
 END PROGRAM main
Index: gcc/testsuite/gfortran.dg/impure_assignment_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/impure_assignment_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/impure_assignment_2.f90	(working copy)
@@ -23,7 +23,7 @@  CONTAINS
      TYPE(node_type), POINTER :: node
      TYPE(node_type), POINTER :: give_next
      give_next => node%next ! { dg-error "Bad target" }
-     node%next => give_next ! { dg-error "Bad pointer object" }
+     node%next => give_next ! { dg-error "variable definition context" }
   END FUNCTION
 ! Comment #2
   PURE integer FUNCTION give_next2(i)
@@ -55,14 +55,14 @@  CONTAINS
     TYPE(T1), POINTER :: RES
     RES => A  ! { dg-error "Bad target" }
     RES => B  ! { dg-error "Bad target" }
-    B => RES  ! { dg-error "Bad pointer object" }
+    B => RES  ! { dg-error "variable definition context" }
   END FUNCTION
   PURE FUNCTION TST2(A) RESULT(RES)
     TYPE(T1), INTENT(IN), TARGET :: A
     TYPE(T1), POINTER :: RES
     allocate (RES)
     RES = A
-    B = RES  ! { dg-error "Cannot assign" }
+    B = RES  ! { dg-error "variable definition context" }
     RES = B
   END FUNCTION
 END MODULE pr20882
Index: gcc/testsuite/gfortran.dg/enum_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/enum_5.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/enum_5.f90	(working copy)
@@ -10,7 +10,7 @@  program main
     enumerator :: blue = 1  
   end enum junk  ! { dg-error "Syntax error" }
 
-  blue = 10  ! { dg-error " assign to a named constant" }
+  blue = 10  ! { dg-error "Unexpected assignment" }
 
 end program main  ! { dg-error "Expecting END ENUM" }
  ! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
Index: gcc/testsuite/gfortran.dg/pointer_intent_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_intent_3.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/pointer_intent_3.f90	(working copy)
@@ -19,11 +19,11 @@  program test
 contains
   subroutine a(p)
     integer, pointer,intent(in) :: p
-    p => null(p)! { dg-error "Cannot assign to INTENT\\(IN\\) variable" }
-    nullify(p)  ! { dg-error "Cannot assign to INTENT\\(IN\\) variable" }
-    allocate(p) ! { dg-error "Cannot allocate INTENT\\(IN\\) variable" }
-    call c(p)   ! { dg-error "is INTENT\\(IN\\) while interface specifies INTENT\\(INOUT\\)" }
-    deallocate(p) ! { dg-error "Cannot deallocate INTENT\\(IN\\) variable" }
+    p => null(p)! { dg-error "pointer association context" }
+    nullify(p)  ! { dg-error "pointer association context" }
+    allocate(p) ! { dg-error "pointer association context" }
+    call c(p)   ! { dg-error "pointer association context" }
+    deallocate(p) ! { dg-error "pointer association context" }
   end subroutine
   subroutine c(p)
     integer, pointer, intent(inout) :: p
@@ -32,10 +32,10 @@  contains
   subroutine b(t)
     type(myT),intent(in) :: t
     t%jp = 5
-    t%jp => null(t%jp)  ! { dg-error "Cannot assign to INTENT\\(IN\\) variable" }
-    nullify(t%jp) ! { dg-error "Cannot assign to INTENT\\(IN\\) variable" }
-    t%j = 7 ! { dg-error "Cannot assign to INTENT\\(IN\\) variable" }
-    allocate(t%jp) ! { dg-error "Cannot allocate INTENT\\(IN\\) variable" }
-    deallocate(t%jp) ! { dg-error "Cannot deallocate INTENT\\(IN\\) variable" }
+    t%jp => null(t%jp)  ! { dg-error "pointer association context" }
+    nullify(t%jp) ! { dg-error "pointer association context" }
+    t%j = 7 ! { dg-error "variable definition context" }
+    allocate(t%jp) ! { dg-error "pointer association context" }
+    deallocate(t%jp) ! { dg-error "pointer association context" }
   end subroutine b
 end program
Index: gcc/testsuite/gfortran.dg/intent_out_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intent_out_1.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/intent_out_1.f90	(working copy)
@@ -3,10 +3,10 @@ 
 ! Contributed by Paul Thomas  <pault@gcc@gnu.org>
   real, parameter :: a =42.0
   real :: b
-  call foo(b + 2.0)    ! { dg-error "must be definable" }
-  call foo(a)          ! { dg-error "must be definable" }
-  call bar(b + 2.0)    ! { dg-error "must be definable" }
-  call bar(a)          ! { dg-error "must be definable" }
+  call foo(b + 2.0)    ! { dg-error "variable definition context" }
+  call foo(a)          ! { dg-error "variable definition context" }
+  call bar(b + 2.0)    ! { dg-error "variable definition context" }
+  call bar(a)          ! { dg-error "variable definition context" }
 contains
   subroutine foo(a)
     real, intent(out) :: a
Index: gcc/testsuite/gfortran.dg/select_type_17.f03
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_17.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/select_type_17.f03	(revision 0)
@@ -0,0 +1,44 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/44044
+! Definability check for select type to expression.
+! This is "bonus feature #2" from comment #3 of the PR.
+
+! Contributed by Janus Weil, janus@gcc.gnu.org.
+
+implicit none
+
+type :: t1
+  integer :: i
+end type
+
+type, extends(t1) :: t2
+end type
+
+type(t1),target :: x1
+type(t2),target :: x2
+
+select type ( y => fun(1) )
+type is (t1)
+  y%i = 1 ! { dg-error "variable definition context" }
+type is (t2)
+  y%i = 2 ! { dg-error "variable definition context" }
+end select
+
+contains
+
+  function fun(i)
+    class(t1),pointer :: fun
+    integer :: i
+    if (i>0) then
+      fun => x1
+    else if (i<0) then
+      fun => x2
+    else
+      fun => NULL()
+    end if
+  end function
+
+end
+
Index: gcc/testsuite/gfortran.dg/protected_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/protected_5.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/protected_5.f90	(working copy)
@@ -49,9 +49,9 @@  end module good2
 program main
   use good2
   implicit none
-  t%j = 15             ! { dg-error "Assigning to PROTECTED variable" }
-  nullify(t%p)         ! { dg-error "Assigning to PROTECTED variable" }
-  allocate(t%array(15))! { dg-error "Assigning to PROTECTED variable" }
+  t%j = 15             ! { dg-error "variable definition context" }
+  nullify(t%p)         ! { dg-error "pointer association context" }
+  allocate(t%array(15))! { dg-error "variable definition context" }
 end program main
 
 ! { dg-final { cleanup-modules "good1 good2 bad1 bad2" } }
Index: gcc/testsuite/gfortran.dg/intent_out_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intent_out_3.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/intent_out_3.f90	(working copy)
@@ -15,6 +15,6 @@  CONTAINS
  END SUBROUTINE S1
 END MODULE M1
 USE M1
-CALL S1(D1%I(3)) ! { dg-error "must be definable" }
+CALL S1(D1%I(3)) ! { dg-error "variable definition context" }
 END
 ! { dg-final { cleanup-modules "m1" } }
Index: gcc/testsuite/gfortran.dg/protected_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/protected_7.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/protected_7.f90	(working copy)
@@ -13,8 +13,8 @@  program p
   integer, pointer :: unprotected_pointer
   ! The next two lines should be rejected; see PR 37513 why
   ! we get such a strange error message.
-  protected_pointer => unprotected_pointer ! { dg-error "only allowed in specification part" }
-  protected_pointer =  unprotected_pointer ! { dg-error "only allowed in specification part" }
+  protected_pointer => unprotected_pointer ! { dg-error "pointer association context" }
+  protected_pointer =  unprotected_pointer ! OK
   unprotected_pointer => protected_target  ! { dg-error "target has PROTECTED attribute" }
   unprotected_pointer => protected_pointer ! OK
 end program p
Index: gcc/testsuite/gfortran.dg/equiv_constraint_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/equiv_constraint_8.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/equiv_constraint_8.f90	(working copy)
@@ -9,7 +9,7 @@  pure integer function test(j)
   common /z/ i
   integer :: k
   equivalence(i,k) ! { dg-error "EQUIVALENCE object in the pure" }
-  k=1 ! { dg-error "in PURE procedure at" }
+  k=1 ! { dg-error "variable definition context" }
   test=i*j
 end function test
 end
Index: gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90	(working copy)
@@ -6,7 +6,7 @@  subroutine sub(i, j, err)
    integer, intent(in), allocatable :: i(:)
    integer, allocatable :: m(:)
    integer n
-   deallocate(i)                    ! { dg-error "Cannot deallocate" "" }
-   deallocate(m, stat=j)            ! { dg-error "cannot be" "" }
-   deallocate(m,stat=n,errmsg=err)  ! { dg-error "cannot be" "" }
+   deallocate(i)                    ! { dg-error "variable definition context" }
+   deallocate(m, stat=j)            ! { dg-error "variable definition context" }
+   deallocate(m,stat=n,errmsg=err)  ! { dg-error "variable definition context" }
 end subroutine sub
Index: gcc/testsuite/gfortran.dg/char_expr_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_expr_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/char_expr_2.f90	(working copy)
@@ -11,5 +11,5 @@  interface
   end subroutine foo
 end interface
 character :: n(5)
-call foo( (n) ) ! { dg-error "must be definable" }
+call foo( (n) ) ! { dg-error "Non-variable expression" }
 end
Index: gcc/testsuite/gfortran.dg/pointer_assign_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_assign_7.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/pointer_assign_7.f90	(working copy)
@@ -18,7 +18,7 @@  type(face_t), pointer :: face
 allocate(face)
 allocate(blu)
 
-face%bla => blu  ! { dg-error "Pointer assignment to non-POINTER" }
+face%bla => blu  ! { dg-error "Non-POINTER in pointer association context" }
 
 end program
 
Index: gcc/testsuite/gfortran.dg/enum_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/enum_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/enum_2.f90	(working copy)
@@ -9,5 +9,7 @@  program main
     enumerator blue = 1  ! { dg-error "Syntax error in ENUMERATOR definition" }
   end enum
 
+  red = 42 ! { dg-error "variable definition context" }
+
   enumerator :: sun  ! { dg-error "ENUM" }
 end program main
Index: gcc/testsuite/gfortran.dg/pr19936_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr19936_1.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/pr19936_1.f90	(working copy)
@@ -1,5 +1,5 @@ 
 ! { dg-do compile }
 program pr19936_1
   integer, parameter :: i=4
-  print *,(/(i,i=1,4)/) ! { dg-error "assign to a named constant" }
+  print *,(/(i,i=1,4)/) ! { dg-error "variable definition context" }
 end program pr19936_1
Index: gcc/testsuite/gfortran.dg/impure_assignment_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/impure_assignment_3.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/impure_assignment_3.f90	(working copy)
@@ -20,7 +20,7 @@  contains
     class is (myType)
       x%a = 42.
       r3 =  43.
-      g = 44.             ! { dg-error "Cannot assign to variable" }
+      g = 44.             ! { dg-error "variable definition context" }
     end select
   end subroutine
 
@@ -30,7 +30,7 @@  contains
       real :: r2
       r1 = 45.
       r2 = 46.
-      g = 47.             ! { dg-error "Cannot assign to variable" }
+      g = 47.             ! { dg-error "variable definition context" }
     end block
   end subroutine
 
Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90	(working copy)
@@ -38,7 +38,7 @@  type(t) :: x
 
 x%ptr2 => x       ! { dg-error "Invalid procedure pointer assignment" }
 
-x => x%ptr2       ! { dg-error "Pointer assignment to non-POINTER" }
+x => x%ptr2       ! { dg-error "Non-POINTER in pointer association context" }
 
 print *, x%ptr1() ! { dg-error "attribute conflicts with" }
 call x%ptr2()     ! { dg-error "attribute conflicts with" }
Index: gcc/testsuite/gfortran.dg/simpleif_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/simpleif_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/simpleif_2.f90	(working copy)
@@ -10,6 +10,6 @@  module read
     subroutine a
       integer, parameter :: n = 2
       if (i .eq. 0) read(j,*) k
-      if (i .eq. 0) n = j    ! { dg-error "assign to a named constant" "" }
+      if (i .eq. 0) n = j    ! { dg-error "Named constant 'n' in variable definition context" }
     end subroutine a
 end module read
Index: gcc/testsuite/gfortran.dg/protected_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/protected_4.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/protected_4.f90	(working copy)
@@ -23,15 +23,15 @@  program main
   integer   :: j 
   logical   :: asgnd
   protected :: j ! { dg-error "only allowed in specification part of a module" }
-  a = 43       ! { dg-error "Assigning to PROTECTED variable" }
-  ap => null() ! { dg-error "Assigning to PROTECTED variable" }
-  nullify(ap)  ! { dg-error "Assigning to PROTECTED variable" }
-  ap => at     ! { dg-error "Assigning to PROTECTED variable" }
-  ap = 3       ! { dg-error "Assigning to PROTECTED variable" }
-  allocate(ap) ! { dg-error "Assigning to PROTECTED variable" }
-  ap = 73      ! { dg-error "Assigning to PROTECTED variable" }
-  call increment(a,at) ! { dg-error "use-associated with PROTECTED attribute" }
-  call pointer_assignments(ap) ! { dg-error "is use-associated with PROTECTED attribute" }
+  a = 43       ! { dg-error "variable definition context" }
+  ap => null() ! { dg-error "pointer association context" }
+  nullify(ap)  ! { dg-error "pointer association context" }
+  ap => at     ! { dg-error "pointer association context" }
+  ap = 3       ! OK
+  allocate(ap) ! { dg-error "pointer association context" }
+  ap = 73      ! OK
+  call increment(a,at) ! { dg-error "variable definition context" }
+  call pointer_assignments(ap) ! { dg-error "pointer association context" }
   asgnd = pointer_check(ap)
 contains
   subroutine increment(a1,a3)
Index: gcc/testsuite/gfortran.dg/protected_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/protected_6.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/protected_6.f90	(working copy)
@@ -19,15 +19,15 @@  end module protmod
 program main
   use protmod
   implicit none
-  a = 43       ! { dg-error "Assigning to PROTECTED variable" }
-  ap => null() ! { dg-error "Assigning to PROTECTED variable" }
-  nullify(ap)  ! { dg-error "Assigning to PROTECTED variable" }
-  ap => at     ! { dg-error "Assigning to PROTECTED variable" }
-  ap = 3       ! { dg-error "Assigning to PROTECTED variable" }
-  allocate(ap) ! { dg-error "Assigning to PROTECTED variable" }
-  ap = 73      ! { dg-error "Assigning to PROTECTED variable" }
-  call increment(a,at) ! { dg-error "use-associated with PROTECTED attribute" }
-  call pointer_assignments(ap) ! { dg-error "is use-associated with PROTECTED attribute" }
+  a = 43       ! { dg-error "variable definition context" }
+  ap => null() ! { dg-error "pointer association context" }
+  nullify(ap)  ! { dg-error "pointer association context" }
+  ap => at     ! { dg-error "pointer association context" }
+  ap = 3       ! OK
+  allocate(ap) ! { dg-error "pointer association context" }
+  ap = 73      ! OK
+  call increment(a,at) ! { dg-error "variable definition context" }
+  call pointer_assignments(ap) ! { dg-error "pointer association context" }
 contains
   subroutine increment(a1,a3)
     integer, intent(inout) :: a1, a3
Index: gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03	(revision 0)
@@ -0,0 +1,11 @@ 
+! { dg-do compile }
+
+! PR fortran/45474
+! Definability checks for INTENT([IN]OUT) and intrinsics.
+
+! Contributed by Tobias Burnus, burnus@gcc.gnu.org.
+
+call execute_command_line("date", .true.,(1),1,'aa') ! { dg-error "variable definition context" }
+call execute_command_line("date", .true.,1,(1),'aa') ! { dg-error "variable definition context" }
+call execute_command_line("date", .true.,1,1,('aa')) ! { dg-error "variable definition context" }
+end
Index: gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90	(working copy)
@@ -16,13 +16,13 @@  contains
     subroutine init2(x)
         integer, allocatable, intent(in) :: x(:)
 
-        allocate(x(3)) ! { dg-error "Cannot allocate" }
+        allocate(x(3)) ! { dg-error "variable definition context" }
     end subroutine init2
 
     subroutine kill(x)
         integer, allocatable, intent(in) :: x(:)
         
-        deallocate(x) ! { dg-error "Cannot deallocate" }
+        deallocate(x) ! { dg-error "variable definition context" }
     end subroutine kill
 
 end program alloc_dummy
Index: gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90	(revision 164495)
+++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90	(working copy)
@@ -6,7 +6,7 @@  subroutine sub(i, j, err)
    integer, intent(in), allocatable :: i(:)
    integer, allocatable :: m(:)
    integer n
-   allocate(i(2))                    ! { dg-error "Cannot allocate" "" }
-   allocate(m(2), stat=j)            ! { dg-error "cannot be" "" }
-   allocate(m(2),stat=n,errmsg=err)  ! { dg-error "cannot be" "" }
+   allocate(i(2)) ! { dg-error "variable definition context" }
+   allocate(m(2), stat=j) ! { dg-error "variable definition context" }
+   allocate(m(2),stat=n,errmsg=err) ! { dg-error "variable definition context" }
 end subroutine sub