diff mbox

[Fortran] F2003: More ASSOCIATE stuff

Message ID 4C698D47.8020902@domob.eu
State New
Headers show

Commit Message

Daniel Kraft Aug. 16, 2010, 7:11 p.m. UTC 
Hi all,

here's another ASSOCIATE patch.  It shifts handling of the variables and 
their initialization to the trans-* phase.  This fixes the problems with 
array boundaries and implements association to variables.  I think most 
of the useful stuff should work with this now.

What does not work (at least not in the complicated cases, like the one 
commented out in associate_1.f03 for now) is association to strings.  I 
could not figure this out, and would like to get the basic handling in 
this patch in to start cleanly with the remaining other bits :)

What also does not work is parsing of component references if you 
associate a variable to a derived-type value; the parser does not yet 
know that it should expect something like '%comp' following this name, 
and unfortunately the type of the target expression and thus of the 
associate-name is not known until resolution in certain cases (I think) 
-- and I do not see a solution at the moment, how we can still parse the 
component references cleanly before resolution without substantial 
reworks (like resolving the variables before parsing the executable 
statements -- which should work in theory?).  Any ideas?  But for now, 
I'd also like to leave this open.

And finally, names associated to expressions may not appear in "variable 
definition contexts"; currently, this is diagnosed for things like "a = 
5" but misses a lot of other cases (i.e., passing to INTENT([IN]OUT) 
dummys).  I do not think we currently have a general implementation of 
"variable definition context" as defined in the standard; do we?  Maybe 
this would be worthwhile to implement as a follow-up patch, too -- and 
in general, not just special-coding the checks for associate names. 
What do you think there?

But for now, the test was regtested on GNU/Linux-x86-32.  I saw two 
failures, namely array_memcpy_3.f90 and bind_c_dts_3.f90 -- but don't 
see how those can be related to ASSOCIATE.  Is this currently broken? 
Or maybe something changed recently and I got caught in a partial svn 
update?  (Although I don't think so.)

Ok for trunk when this is figured out?

Yours,
Daniel

Comments

Tobias Burnus Aug. 16, 2010, 9:13 p.m. UTC | #1 
Daniel Kraft wrote:
> here's another ASSOCIATE patch.  It shifts handling of the variables 
> and their initialization to the trans-* phase.  This fixes the 
> problems with array boundaries and implements association to 
> variables.  I think most of the useful stuff should work with this now.
Awesome!

> What does not work [...] is association to strings. [...]
> parsing of component references if you associate a variable to a 
> derived-type value
(The latter is a rather important case, looking at my Fortran 2003 books 
...)

You can add to the list: Polymorphic types. The following example is 
rejected with:

associate ( one => a, two => b)
                     1
Error: CLASS variable 'one' at (1) must be dummy, allocatable or pointer

!----------------------------
type t
end type t

type, extends(t) :: t2
end type t2

class(t), allocatable :: a, b
allocate( t :: a)
allocate( t2 :: b)

associate ( one => a, two => b)
   select type(two)
     type is (t)
       stop 'ERROR'
     type is (t2)
       print *, 'OK', two
     class default
       stop 'ERROR'
   end select
   select type(one)
     type is (t2)
       stop 'ERROR'
     type is (t)
       print *, 'OK', one
     class default
       stop 'ERROR'
   end select
end associate
end
!----------------------------


I also would expect an error for:

subroutine test(x)
   integer, intent(in) :: x
   associate ( y => x)
     y = 7
   end associate
end subroutine test

due to the INTENT(IN).


> I saw two failures, namely array_memcpy_3.f90 and bind_c_dts_3.f90.  
> Is this currently broken?

I saw them as well - though the array_memcpy_3.f90 looked a bit spurious 
- especially, I got either a MEMREF or memcopy. With bind_c_dts_3.f90, I 
wonder whether this is due to my recent DT bugfix. I thought I fixed 
that before the committal - can you try to find out why you see this? 
Maybe do an "svn up" in gcc/testsuite/gfortran.dg to make sure your file 
is up to date.

Looking at http://gcc.gnu.org/ml/gcc-testresults/2010-08/msg01641.html 
or at http://gcc.gnu.org/ml/gcc-testresults/2010-08/msg01640.html I also 
see the array_memcpy_3.f90 failure, but no bind_c_dts_3.f90 failure. 
Thus, I think this failure does not prevent a committal.

> Ok for trunk when this is figured out?

OK, but I have one nit:

+	  gfc_error ("'%s' at %L associated to %s can not"
+		     " be used in a variable definition context",
+		     sym->name,&sym->declared_at,
+		     (target->expr_type == EXPR_VARIABLE
+		      ? "vector-indexed target" : "expression"));


Can you split this into two gfc_errors? I think we make the live for the 
translators much easier if we do not use %s + a string.

More general remark, not preventing the committal:

+  ASSOCIATE (a =>  5,&  ! { dg-error "variable definition context" }
+             b =>  arr((/ 1, 3 /))) ! { dg-error "variable definition context" }
+    a = 4
+    b = 7


At least for long ASSOCIATE blocks, I think it would be more helpful to 
have the error in the "a = 4" line and not in the "a => 5" line.

Tobias

PS: I have not yet thought about the other points you have raised in 
your email.
Daniel Kraft Aug. 17, 2010, 7:58 a.m. UTC | #2 
Tobias Burnus wrote:
>  Daniel Kraft wrote:
>> here's another ASSOCIATE patch.  It shifts handling of the variables 
>> and their initialization to the trans-* phase.  This fixes the 
>> problems with array boundaries and implements association to 
>> variables.  I think most of the useful stuff should work with this now.
> Awesome!
> 
>> What does not work [...] is association to strings. [...]
>> parsing of component references if you associate a variable to a 
>> derived-type value
> (The latter is a rather important case, looking at my Fortran 2003 books 
> ...)
> 
> You can add to the list: Polymorphic types. The following example is 
> rejected with:

Yes, I forgot about those (when writing the email).  You're right of 
course, this is something to also still consider.  As well as updating 
SELECT_TYPE support.

> I also would expect an error for:
> 
> subroutine test(x)
>   integer, intent(in) :: x
>   associate ( y => x)
>     y = 7
>   end associate
> end subroutine test
> 
> due to the INTENT(IN).

This is what I meant (and other stuff) with the variable definition 
context "enhancement" -- although I really wonder whether we can use 
this to put other errors together as well (for other things that are 
"read-only").  The same restrictions are valid for INTENT(IN) variables 
themselves or PARAMETERs, for instance -- so I'd try to implement some 
general concept of variable definition context in order to unify and fix 
this.  If that's ok, in a seperate patch.

>> I saw two failures, namely array_memcpy_3.f90 and bind_c_dts_3.f90.  
>> Is this currently broken?
> 
> I saw them as well - though the array_memcpy_3.f90 looked a bit spurious 
> - especially, I got either a MEMREF or memcopy. With bind_c_dts_3.f90, I 
> wonder whether this is due to my recent DT bugfix. I thought I fixed 
> that before the committal - can you try to find out why you see this? 
> Maybe do an "svn up" in gcc/testsuite/gfortran.dg to make sure your file 
> is up to date.

I thought I did a uniform update, but probably only svn up gcc/fortran 
before my last committal and no test-suite update -- the BIND(C) stuff 
is fixed now, thus I guess we can see this as no regressions.

>> Ok for trunk when this is figured out?
> 
> OK, but I have one nit:
> 
> +      gfc_error ("'%s' at %L associated to %s can not"
> +             " be used in a variable definition context",
> +             sym->name,&sym->declared_at,
> +             (target->expr_type == EXPR_VARIABLE
> +              ? "vector-indexed target" : "expression"));
> 
> 
> Can you split this into two gfc_errors? I think we make the live for the 
> translators much easier if we do not use %s + a string.

I wondered about this, myself.  My rationale for why I thought it is not 
too bad was that the expressions inserted are somewhat "complete 
expressions" specifying "a thing" -- and thus it should be hopefully 
possible to translate this constructions (or the individual strings). 
But you're probably right (and I don't have any translation experience), 
so I'll change that.

> More general remark, not preventing the committal:
> 
> +  ASSOCIATE (a =>  5,&  ! { dg-error "variable definition context" }
> +             b =>  arr((/ 1, 3 /))) ! { dg-error "variable definition 
> context" }
> +    a = 4
> +    b = 7
> 
> 
> At least for long ASSOCIATE blocks, I think it would be more helpful to 
> have the error in the "a = 4" line and not in the "a => 5" line.

This could also be fixed with my plans abuot variable definition 
contexts.  I agree it is helpful, but I don't see how to do this 
reliably with the current code -- at least not without adding special 
fields like "position of usage where variable flag was set" to the data 
structures which seems not like the best idea to me.  Instead, I'd like 
to go for the variable definition context.

So do you agree with committing when I've split the error message?

Yours,
Daniel
Tobias Burnus Aug. 17, 2010, 8:13 a.m. UTC | #3 
On 08/17/2010 09:58 AM, Daniel Kraft wrote:
> Tobias Burnus wrote: I also would expect an error for: The same 
> restrictions are valid for INTENT(IN) variables themselves or 
> PARAMETERs, for instance -- so I'd try to implement some general 
> concept of variable definition context in order to unify and fix 
> this.  If that's ok, in a seperate patch.

Yes, that's fine. I just wanted to mention it as you talked about using 
it as actual argument to "INTENT((IN)OUT)" - thus I wanted to make sure 
this usage case does not get forgotten.

>> OK, but I have one nit:
>>
>> +      gfc_error ("'%s' at %L associated to %s can not"
>> +             " be used in a variable definition context",
>> +             sym->name,&sym->declared_at,
>> +             (target->expr_type == EXPR_VARIABLE
>> +              ? "vector-indexed target" : "expression"));
>>
>>
>> Can you split this into two gfc_errors? I think we make the live for 
>> the translators much easier if we do not use %s + a string.
>
> I wondered about this, myself.  My rationale for why I thought it is 
> not too bad was that the expressions inserted are somewhat "complete 
> expressions" specifying "a thing" -- and thus it should be hopefully 
> possible to translate this constructions (or the individual strings).

Translating individual strings without context is difficult - it it 
might happen that, e.g., "expression" occurs twice. If you then need an 
article, you might be in trouble, e.g.
"... to an expression ..."  vs. "... to a vector-indexed target"
Where to place the article? In the long string you cannot as it is 
depends on the term which is in "%s". And for "expression" you only can 
do it if (a) you realize that it is used in the context above and (b) 
when "expression" is not used elsewhere.

I think in general, we do not give much help to translators with our 
strings. I think it is possible to annotate the strings and thus helping 
the translators to understand the terms, e.g. "dummy" or "parameter" 
might be wrongly interpreted by compiler/computer science translators 
without Fortran background.

Have a look at gcc/po/gcc.pot to see how it looks from a translator 
perspective and note (a) how many strings they have to translate (namely 
7865), how many terms are used multiple times (i.e. multiple files 
listed for a single mesgid), and how few strings have a comment above to 
help the translator (Answer: Essentially none; there are comments 
[search for "#."] but they are for the programmers and not for the 
translators). -- I think we should try to improve the translator 
comments ...

> So do you agree with committing when I've split the error message?

Yes.

Tobias
Daniel Kraft Aug. 17, 2010, 8:26 a.m. UTC | #4 
Tobias Burnus wrote:
>  On 08/17/2010 09:58 AM, Daniel Kraft wrote:
>> Tobias Burnus wrote: I also would expect an error for: The same 
>> restrictions are valid for INTENT(IN) variables themselves or 
>> PARAMETERs, for instance -- so I'd try to implement some general 
>> concept of variable definition context in order to unify and fix 
>> this.  If that's ok, in a seperate patch.
> 
> Yes, that's fine. I just wanted to mention it as you talked about using 
> it as actual argument to "INTENT((IN)OUT)" - thus I wanted to make sure 
> this usage case does not get forgotten.
> 
>>> OK, but I have one nit:
>>>
>>> +      gfc_error ("'%s' at %L associated to %s can not"
>>> +             " be used in a variable definition context",
>>> +             sym->name,&sym->declared_at,
>>> +             (target->expr_type == EXPR_VARIABLE
>>> +              ? "vector-indexed target" : "expression"));
>>>
>>>
>>> Can you split this into two gfc_errors? I think we make the live for 
>>> the translators much easier if we do not use %s + a string.
>>
>> I wondered about this, myself.  My rationale for why I thought it is 
>> not too bad was that the expressions inserted are somewhat "complete 
>> expressions" specifying "a thing" -- and thus it should be hopefully 
>> possible to translate this constructions (or the individual strings).
> 
> Translating individual strings without context is difficult - it it 
> might happen that, e.g., "expression" occurs twice. If you then need an 
> article, you might be in trouble, e.g.
> "... to an expression ..."  vs. "... to a vector-indexed target"
> Where to place the article? In the long string you cannot as it is 
> depends on the term which is in "%s". And for "expression" you only can 
> do it if (a) you realize that it is used in the context above and (b) 
> when "expression" is not used elsewhere.
> 
> I think in general, we do not give much help to translators with our 
> strings. I think it is possible to annotate the strings and thus helping 
> the translators to understand the terms, e.g. "dummy" or "parameter" 
> might be wrongly interpreted by compiler/computer science translators 
> without Fortran background.
> 
> Have a look at gcc/po/gcc.pot to see how it looks from a translator 
> perspective and note (a) how many strings they have to translate (namely 
> 7865), how many terms are used multiple times (i.e. multiple files 
> listed for a single mesgid), and how few strings have a comment above to 
> help the translator (Answer: Essentially none; there are comments 
> [search for "#."] but they are for the programmers and not for the 
> translators). -- I think we should try to improve the translator 
> comments ...
> 
>> So do you agree with committing when I've split the error message?
> 
> Yes.

Alright, I did the split and committed as rev. 163295.  Thanks for the 
fast review!

cheers,
Daniel
diff mbox

Patch

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 163267)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -672,9 +672,10 @@  gfc_conv_variable (gfc_se * se, gfc_expr
 	    se->expr = build_fold_indirect_ref_loc (input_location,
 						se->expr);
 
-          /* Dereference non-character pointer variables. 
+	  /* Dereference non-character pointer variables. 
 	     These must be dummies, results, or scalars.  */
-	  if ((sym->attr.pointer || sym->attr.allocatable)
+	  if ((sym->attr.pointer || sym->attr.allocatable
+	       || gfc_is_associate_pointer (sym))
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 163268)
+++ gcc/fortran/symbol.c	(working copy)
@@ -4758,3 +4758,23 @@  gfc_find_proc_namespace (gfc_namespace* 
 
   return ns;
 }
+
+
+/* Check if an associate-variable should be translated as an `implicit' pointer
+   internally (if it is associated to a variable and not an array with
+   descriptor).  */
+
+bool
+gfc_is_associate_pointer (gfc_symbol* sym)
+{
+  if (!sym->assoc)
+    return false;
+
+  if (!sym->assoc->variable)
+    return false;
+
+  if (sym->attr.dimension && sym->as->type != AS_EXPLICIT)
+    return false;
+
+  return true;
+}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 163268)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2007,6 +2007,8 @@  typedef struct gfc_association_list
 
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symtree *st; /* Symtree corresponding to name.  */
+  locus where;
+
   gfc_expr *target;
 }
 gfc_association_list;
@@ -2579,6 +2581,8 @@  void gfc_free_finalizer (gfc_finalizer *
 gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
 gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
 
+bool gfc_is_associate_pointer (gfc_symbol*);
+
 /* intrinsic.c -- true if working in an init-expr, false otherwise.  */
 extern bool gfc_init_expr_flag;
 
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 163267)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -1183,13 +1183,13 @@  gfc_is_nodesc_array (gfc_symbol * sym)
   if (sym->attr.pointer || sym->attr.allocatable)
     return 0;
 
+  /* We want a descriptor for associate-name arrays that do not have an
+     explicitely known shape already.  */
+  if (sym->assoc && sym->as->type != AS_EXPLICIT)
+    return 0;
+
   if (sym->attr.dummy)
-    {
-      if (sym->as->type != AS_ASSUMED_SHAPE)
-        return 1;
-      else
-        return 0;
-    }
+    return sym->as->type != AS_ASSUMED_SHAPE;
 
   if (sym->attr.result || sym->attr.function)
     return 0;
@@ -1798,7 +1798,8 @@  gfc_sym_type (gfc_symbol * sym)
     }
   else
     {
-      if (sym->attr.allocatable || sym->attr.pointer)
+      if (sym->attr.allocatable || sym->attr.pointer
+	  || gfc_is_associate_pointer (sym))
 	type = gfc_build_pointer_type (sym, type);
       if (sym->attr.pointer || sym->attr.cray_pointee)
 	GFC_POINTER_TYPE_P (type) = 1;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 163268)
+++ gcc/fortran/resolve.c	(working copy)
@@ -8295,39 +8295,7 @@  resolve_block_construct (gfc_code* code)
   gfc_resolve (code->ext.block.ns);
 
   /* For an ASSOCIATE block, the associations (and their targets) are already
-     resolved during gfc_resolve_symbol.  Here, we have to add code
-     to assign expression values to the variables associated to expressions.  */
-  if (code->ext.block.assoc)
-    {
-      gfc_association_list* a;     
-      gfc_code* assignTail;
-      gfc_code* assignHead;
-
-      assignHead = assignTail = NULL;
-      for (a = code->ext.block.assoc; a; a = a->next)
-	if (!a->variable)
-	  {
-	    gfc_code* newAssign;
-
-	    newAssign = gfc_get_code ();
-	    newAssign->op = EXEC_ASSIGN;
-	    newAssign->loc = gfc_current_locus;
-	    newAssign->expr1 = gfc_lval_expr_from_sym (a->st->n.sym);
-	    newAssign->expr2 = a->target;
-
-	    if (!assignHead)
-	      assignHead = newAssign;
-	    else
-	      {
-		gcc_assert (assignTail);
-		assignTail->next = newAssign;
-	      }
-	    assignTail = newAssign;
-	  }
-
-      assignTail->next = code->ext.block.ns->code;
-      code->ext.block.ns->code = assignHead;
-    }
+     resolved during gfc_resolve_symbol.  */
 }
 
 
@@ -9523,12 +9491,11 @@  resolve_fl_var_and_proc (gfc_symbol *sym
 		     sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
-
     }
   else
     {
       if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer
-	  && !sym->attr.dummy && sym->ts.type != BT_CLASS)
+	  && !sym->attr.dummy && sym->ts.type != BT_CLASS && !sym->assoc)
 	{
 	  gfc_error ("Array '%s' at %L cannot have a deferred shape",
 		     sym->name, &sym->declared_at);
@@ -11692,59 +11659,66 @@  resolve_symbol (gfc_symbol *sym)
      they get their type-spec set this way.  */
   if (sym->assoc)
     {
+      gfc_expr* target;
+      bool to_var;
+
       gcc_assert (sym->attr.flavor == FL_VARIABLE);
-      if (gfc_resolve_expr (sym->assoc->target) != SUCCESS)
+
+      target = sym->assoc->target;
+      if (gfc_resolve_expr (target) != SUCCESS)
 	return;
 
-      sym->ts = sym->assoc->target->ts;
+      /* For variable targets, we get some attributes from the target.  */
+      if (target->expr_type == EXPR_VARIABLE)
+	{
+	  gfc_symbol* tsym;
+
+	  gcc_assert (target->symtree);
+	  tsym = target->symtree->n.sym;
+
+	  sym->attr.asynchronous = tsym->attr.asynchronous;
+	  sym->attr.volatile_ = tsym->attr.volatile_;
+
+	  sym->attr.target = (tsym->attr.target || tsym->attr.pointer);
+	}
+
+      sym->ts = target->ts;
       gcc_assert (sym->ts.type != BT_UNKNOWN);
 
-      if (sym->attr.dimension && sym->assoc->target->rank == 0)
+      /* 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)
+	{
+	  gfc_error ("'%s' at %L associated to %s can not"
+		     " be used in a variable definition context",
+		     sym->name, &sym->declared_at,
+		     (target->expr_type == EXPR_VARIABLE
+		      ? "vector-indexed target" : "expression"));
+	  return;
+	}
+      sym->assoc->variable = to_var;
+
+      /* Finally resolve if this is an array or not.  */
+      if (sym->attr.dimension && target->rank == 0)
 	{
 	  gfc_error ("Associate-name '%s' at %L is used as array",
 		     sym->name, &sym->declared_at);
 	  sym->attr.dimension = 0;
 	  return;
 	}
-      if (sym->assoc->target->rank > 0)
+      if (target->rank > 0)
 	sym->attr.dimension = 1;
 
       if (sym->attr.dimension)
 	{
-	  int dim;
-
 	  sym->as = gfc_get_array_spec ();
-	  sym->as->rank = sym->assoc->target->rank;
-	  sym->as->type = AS_EXPLICIT;
+	  sym->as->rank = target->rank;
+	  sym->as->type = AS_DEFERRED;
 
 	  /* Target must not be coindexed, thus the associate-variable
 	     has no corank.  */
 	  sym->as->corank = 0;
-
-	  for (dim = 0; dim < sym->assoc->target->rank; ++dim)
-	    {
-	      gfc_expr* dim_expr;
-	      gfc_expr* e;
-
-	      dim_expr = gfc_get_constant_expr (BT_INTEGER,
-						gfc_default_integer_kind,
-						&sym->declared_at);
-	      mpz_set_si (dim_expr->value.integer, dim + 1);
-
-	      e = gfc_build_intrinsic_call ("lbound", sym->declared_at, 3,
-					    gfc_copy_expr (sym->assoc->target),
-					    gfc_copy_expr (dim_expr), NULL);
-	      gfc_resolve_expr (e);
-	      sym->as->lower[dim] = e;
-
-	      e = gfc_build_intrinsic_call ("ubound", sym->declared_at, 3,
-					    gfc_copy_expr (sym->assoc->target),
-					    gfc_copy_expr (dim_expr), NULL);
-	      gfc_resolve_expr (e);
-	      sym->as->upper[dim] = e;
-
-	      gfc_free_expr (dim_expr);
-	    }
 	}
     }
 
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 163268)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -1206,7 +1206,7 @@  gfc_get_symbol_decl (gfc_symbol * sym)
     }
 
   /* Remember this variable for allocation/cleanup.  */
-  if (sym->attr.dimension || sym->attr.allocatable
+  if (sym->attr.dimension || sym->attr.allocatable || sym->assoc
       || (sym->ts.type == BT_CLASS &&
 	  (CLASS_DATA (sym)->attr.dimension
 	   || CLASS_DATA (sym)->attr.allocatable))
@@ -3095,12 +3095,125 @@  init_intent_out_dt (gfc_symbol * proc_sy
 }
 
 
+/* Do proper initialization for ASSOCIATE names.  */
+
+static void
+trans_associate_var (gfc_symbol* sym, gfc_wrapped_block* block)
+{
+  gfc_expr* e;
+  tree tmp;
+
+  gcc_assert (sym->assoc);
+  e = sym->assoc->target;
+
+  /* Do a `pointer assignment' with updated descriptor (or assign descriptor
+     to array temporary) for arrays with either unknown shape or if associating
+     to a variable.  */
+  if (sym->attr.dimension
+      && (sym->as->type == AS_DEFERRED || sym->assoc->variable))
+    {
+      gfc_se se;
+      gfc_ss* ss;
+      tree desc;
+
+      desc = sym->backend_decl;
+
+      /* If association is to an expression, evaluate it and create temporary.
+	 Otherwise, get descriptor of target for pointer assignment.  */
+      gfc_init_se (&se, NULL);
+      ss = gfc_walk_expr (e);
+      if (sym->assoc->variable)
+	{
+	  se.direct_byref = 1;
+	  se.expr = desc;
+	}
+      gfc_conv_expr_descriptor (&se, e, ss);
+
+      /* If we didn't already do the pointer assignment, set associate-name
+	 descriptor to the one generated for the temporary.  */
+      if (!sym->assoc->variable)
+	{
+	  tree offs;
+	  int dim;
+
+	  gfc_add_modify (&se.pre, desc, se.expr);
+
+	  /* The generated descriptor has lower bound zero (as array
+	     temporary), shift bounds so we get lower bounds of 1 all the time.
+	     The offset has to be corrected as well.
+	     Because the ubound shift and offset depends on the lower bounds, we
+	     first calculate those and set the lbound to one last.  */
+
+	  offs = gfc_conv_descriptor_offset_get (desc);
+	  for (dim = 0; dim < e->rank; ++dim)
+	    {
+	      tree from, to;
+	      tree stride;
+
+	      from = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+	      to = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
+	      stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+
+	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+				 gfc_index_one_node, from);
+	      to = fold_build2 (PLUS_EXPR, gfc_array_index_type, to, tmp);
+
+	      tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, stride);
+	      offs = fold_build2 (MINUS_EXPR, gfc_array_index_type, offs, tmp);
+
+	      gfc_conv_descriptor_ubound_set (&se.pre, desc,
+					      gfc_rank_cst[dim], to);
+	    }
+	  gfc_conv_descriptor_offset_set (&se.pre, desc, offs);
+
+	  for (dim = 0; dim < e->rank; ++dim)
+	    gfc_conv_descriptor_lbound_set (&se.pre, desc, gfc_rank_cst[dim],
+					    gfc_index_one_node);
+	}
+
+      /* Done, register stuff as init / cleanup code.  */
+      gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
+			    gfc_finish_block (&se.post));
+    }
+
+  /* Do a scalar pointer assignment; this is for scalar variable targets.  */
+  else if (gfc_is_associate_pointer (sym))
+    {
+      gfc_se se;
+
+      gcc_assert (!sym->attr.dimension);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, e);
+
+      tmp = TREE_TYPE (sym->backend_decl);
+      tmp = gfc_build_addr_expr (tmp, se.expr);
+      gfc_add_modify (&se.pre, sym->backend_decl, tmp);
+      
+      gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
+			    gfc_finish_block (&se.post));
+    }
+
+  /* Do a simple assignment.  This is for scalar expressions, where we
+     can simply use expression assignment.  */
+  else
+    {
+      gfc_expr* lhs;
+
+      lhs = gfc_lval_expr_from_sym (sym);
+      tmp = gfc_trans_assignment (lhs, e, false, true);
+      gfc_add_init_cleanup (block, tmp, NULL_TREE);
+    }
+}
+
+
 /* Generate function entry and exit code, and add it to the function body.
    This includes:
     Allocation and initialization of array variables.
     Allocation of character string variables.
     Initialization and possibly repacking of dummy arrays.
     Initialization of ASSIGN statement auxiliary variable.
+    Initialization of ASSOCIATE names.
     Automatic deallocation.  */
 
 void
@@ -3159,7 +3272,9 @@  gfc_trans_deferred_vars (gfc_symbol * pr
     {
       bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
 				   && sym->ts.u.derived->attr.alloc_comp;
-      if (sym->attr.dimension)
+      if (sym->assoc)
+	trans_associate_var (sym, block);
+      else if (sym->attr.dimension)
 	{
 	  switch (sym->as->type)
 	    {
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 163267)
+++ gcc/fortran/match.c	(working copy)
@@ -1827,6 +1827,7 @@  gfc_match_associate (void)
 	  gfc_error ("Expected association at %C");
 	  goto assocListError;
 	}
+      newAssoc->where = gfc_current_locus;
 
       /* Check that the current name is not yet in the list.  */
       for (a = new_st.ext.block.assoc; a; a = a->next)
@@ -1844,10 +1845,11 @@  gfc_match_associate (void)
 	  goto assocListError;
 	}
 
-      /* The target is a variable (and may be used as lvalue) if it's an
-	 EXPR_VARIABLE and does not have vector-subscripts.  */
-      newAssoc->variable = (newAssoc->target->expr_type == EXPR_VARIABLE
-			    && !gfc_has_vector_subscript (newAssoc->target));
+      /* 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;
 
       /* Put it into the list.  */
       newAssoc->next = new_st.ext.block.assoc;
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 163268)
+++ gcc/fortran/parse.c	(working copy)
@@ -3215,23 +3215,21 @@  parse_associate (void)
   new_st.ext.block.ns = my_ns;
   gcc_assert (new_st.ext.block.assoc);
 
-  /* Add all associate-names as BLOCK variables.  There values will be assigned
-     to them during resolution of the ASSOCIATE construct.  */
+  /* Add all associate-names as BLOCK variables.  Creating them is enough
+     for now, they'll get their values during trans-* phase.  */
   gfc_current_ns = my_ns;
   for (a = new_st.ext.block.assoc; a; a = a->next)
     {
-      if (a->variable)
-	{
-	  gfc_error ("Association to variables is not yet supported at %C");
-	  return;
-	}
+      gfc_symbol* sym;
 
       if (gfc_get_sym_tree (a->name, NULL, &a->st, false))
 	gcc_unreachable ();
 
-      a->st->n.sym->attr.flavor = FL_VARIABLE;
-      a->st->n.sym->assoc = a;
-      gfc_set_sym_referenced (a->st->n.sym);
+      sym = a->st->n.sym;
+      sym->attr.flavor = FL_VARIABLE;
+      sym->assoc = a;
+      sym->declared_at = a->where;
+      gfc_set_sym_referenced (sym);
     }
 
   accept_statement (ST_ASSOCIATE);
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 163268)
+++ gcc/fortran/primary.c	(working copy)
@@ -2982,12 +2982,8 @@  match_variable (gfc_expr **result, int e
 	  gfc_error ("Assigning to PROTECTED variable at %C");
 	  return MATCH_ERROR;
 	}
-      if (sym->assoc && !sym->assoc->variable)
-	{
-	  gfc_error ("'%s' associated to expression can't appear in a variable"
-		     " definition context at %C", sym->name);
-	  return MATCH_ERROR;
-	}
+      if (sym->assoc)
+	sym->assoc->variable = 1;
       break;
 
     case FL_UNKNOWN:
Index: gcc/testsuite/gfortran.dg/associate_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_3.f03	(revision 163268)
+++ gcc/testsuite/gfortran.dg/associate_3.f03	(working copy)
@@ -31,10 +31,6 @@  PROGRAM main
   ASSOCIATE (a => 1, b => 2, a => 3) ! { dg-error "Duplicate name 'a'" }
 
   ASSOCIATE (a => 5)
-    a = 4 ! { dg-error "variable definition context" }
-  ENd ASSOCIATE
-
-  ASSOCIATE (a => 5)
     INTEGER :: b ! { dg-error "Unexpected data declaration statement" }
   END ASSOCIATE
 END PROGRAM main ! { dg-error "Expecting END ASSOCIATE" }
Index: gcc/testsuite/gfortran.dg/associate_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_5.f03	(revision 163268)
+++ gcc/testsuite/gfortran.dg/associate_5.f03	(working copy)
@@ -6,8 +6,21 @@ 
 
 PROGRAM main
   IMPLICIT NONE
+  INTEGER :: nontarget
+  INTEGER :: arr(3)
+  INTEGER, POINTER :: ptr
 
   ASSOCIATE (a => 5) ! { dg-error "is used as array" }
     PRINT *, a(3)
   END ASSOCIATE
+
+  ASSOCIATE (a => nontarget)
+    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
+  END ASSOCIATE
 END PROGRAM main
Index: gcc/testsuite/gfortran.dg/associate_7.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_7.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/associate_7.f03	(revision 0)
@@ -0,0 +1,21 @@ 
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+
+! PR fortran/38936
+! Check association and pointers.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: tgt
+  INTEGER, POINTER :: ptr
+
+  tgt = 1
+  ASSOCIATE (x => tgt)
+    ptr => x
+    IF (ptr /= 1) CALL abort ()
+    ptr = 2
+  END ASSOCIATE
+  IF (tgt /= 2) CALL abort ()
+END PROGRAM main
Index: gcc/testsuite/gfortran.dg/associate_6.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_6.f03	(revision 163268)
+++ gcc/testsuite/gfortran.dg/associate_6.f03	(working copy)
@@ -7,8 +7,6 @@ 
 
 ! Contributed by Daniel Kraft, d@domob.eu.
 
-! FIXME: XFAIL'ed because this is not yet implemented 'correctly'.
-
 MODULE m
   IMPLICIT NONE
 
@@ -31,8 +29,11 @@  PROGRAM main
 
   ASSOCIATE (arr => func (4))
     ! func should only be called once here, not again for the bounds!
+
+    IF (LBOUND (arr, 1) /= 1 .OR. UBOUND (arr, 1) /= 4) CALL abort ()
+    IF (arr(1) /= 1 .OR. arr(4) /= 4) CALL abort ()
   END ASSOCIATE
 END PROGRAM main
 ! { dg-final { cleanup-modules "m" } }
-! { dg-final { scan-tree-dump-times "func" 2 "original" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "func" 2 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
Index: gcc/testsuite/gfortran.dg/associate_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_1.f03	(revision 163268)
+++ gcc/testsuite/gfortran.dg/associate_1.f03	(working copy)
@@ -1,5 +1,5 @@ 
 ! { dg-do run }
-! { dg-options "-std=f2003 -fall-intrinsics" }
+! { dg-options "-std=f2003 -fall-intrinsics -cpp" }
 
 ! PR fortran/38936
 ! Check the basic semantics of the ASSOCIATE construct.
@@ -8,6 +8,13 @@  PROGRAM main
   IMPLICIT NONE
   REAL :: a, b, c
   INTEGER, ALLOCATABLE :: arr(:)
+  INTEGER :: mat(3, 3)
+
+  TYPE :: myt
+    INTEGER :: comp
+  END TYPE myt
+
+  TYPE(myt) :: tp
 
   a = -2.0
   b = 3.0
@@ -20,9 +27,6 @@  PROGRAM main
     IF (ABS (t - a - b) > 1.0e-3) CALL abort ()
   END ASSOCIATE
 
-  ! TODO: Test association to variables when that is supported.
-  ! TODO: Test association to derived types.
-
   ! Test association to arrays.
   ALLOCATE (arr(3))
   arr = (/ 1, 2, 3 /)
@@ -34,6 +38,12 @@  PROGRAM main
     IF (ANY (xyz /= (/ 1, 3, 5 /))) CALL abort ()
   END ASSOCIATE
 
+  ! Target is vector-indexed.
+  ASSOCIATE (foo => arr((/ 3, 1 /)))
+    IF (LBOUND (foo, 1) /= 1 .OR. UBOUND (foo, 1) /= 2) CALL abort ()
+    IF (foo(1) /= 3 .OR. foo(2) /= 1) CALL abort ()
+  END ASSOCIATE
+
   ! Named and nested associate.
   myname: ASSOCIATE (x => a - b * c)
     ASSOCIATE (y => 2.0 * x)
@@ -49,6 +59,33 @@  PROGRAM main
     END ASSOCIATE
   END ASSOCIATE
 
+  ! Association to variables.
+  mat = 0
+  mat(2, 2) = 5;
+  ASSOCIATE (x => arr(2), y => mat(2:3, 1:2))
+    IF (x /= 2) CALL abort ()
+    IF (ANY (LBOUND (y) /= (/ 1, 1 /) .OR. UBOUND (y) /= (/ 2, 2 /))) &
+      CALL abort ()
+    IF (y(1, 2) /= 5) CALL abort ()
+
+    x = 7
+    y = 8
+  END ASSOCIATE
+  IF (arr(2) /= 7 .OR. ANY (mat(2:3, 1:2) /= 8)) CALL abort ()
+
+  ! Association to derived type and component.
+  tp = myt (1)
+  ASSOCIATE (x => tp, y => tp%comp)
+    ! FIXME: Parsing of derived-type associate names, tests with x.
+    IF (y /= 1) CALL abort ()
+    y = 5
+  END ASSOCIATE
+  IF (tp%comp /= 5) CALL abort ()
+
+  ! Association to character variables.
+  ! FIXME: Enable character test, once this works.
+  !CALL test_char (5)
+
 CONTAINS
 
   FUNCTION func ()
@@ -56,4 +93,21 @@  CONTAINS
     func = (/ 1, 3, 5 /)
   END FUNCTION func
 
+#if 0
+  ! Test association to character variable with automatic length.
+  SUBROUTINE test_char (n)
+    INTEGER, INTENT(IN) :: n
+
+    CHARACTER(LEN=n) :: str
+
+    str = "foobar"
+    ASSOCIATE (my => str)
+      IF (LEN (my) /= n) CALL abort ()
+      IF (my /= "fooba") CALL abort ()
+      my = "abcdef"
+    END ASSOCIATE
+    IF (str /= "abcde") CALL abort ()
+  END SUBROUTINE test_char
+#endif
+
 END PROGRAM main