Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c	(revision 257682)
--- gcc/fortran/primary.c	(working copy)
*************** gfc_match_varspec (gfc_expr *primary, in
*** 2082,2088 ****
      {
        bool permissible;
  
!       /* These target expressions can ge resolved at any time.  */
        permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
  		    && (tgt_expr->symtree->n.sym->attr.use_assoc
  			|| tgt_expr->symtree->n.sym->attr.host_assoc
--- 2082,2088 ----
      {
        bool permissible;
  
!       /* These target expressions can be resolved at any time.  */
        permissible = tgt_expr && tgt_expr->symtree && tgt_expr->symtree->n.sym
  		    && (tgt_expr->symtree->n.sym->attr.use_assoc
  			|| tgt_expr->symtree->n.sym->attr.host_assoc
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 257682)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8635,8641 ****
    if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
      {
        if (!sym->ts.u.cl)
! 	sym->ts.u.cl = target->ts.u.cl;
  
        if (!sym->ts.u.cl->length && !sym->ts.deferred)
  	{
--- 8635,8654 ----
    if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
      {
        if (!sym->ts.u.cl)
! 	{
! 	  if (target->expr_type != EXPR_CONSTANT
! 	      && !target->ts.u.cl->length)
! 	    {
! 	      sym->ts.u.cl = gfc_get_charlen();
! 	      sym->ts.deferred = 1;
! 
! 	      /* This is reset in trans-stmt.c after the assignment
! 		 of the target expression to the associate name.  */
! 	      sym->attr.allocatable = 1;
! 	    }
! 	  else
! 	    sym->ts.u.cl = target->ts.u.cl;
! 	}
  
        if (!sym->ts.u.cl->length && !sym->ts.deferred)
  	{
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 257682)
--- gcc/fortran/trans-array.c	(working copy)
*************** bool
*** 9470,9498 ****
  gfc_is_reallocatable_lhs (gfc_expr *expr)
  {
    gfc_ref * ref;
  
    if (!expr->ref)
      return false;
  
    /* An allocatable class variable with no reference.  */
!   if (expr->symtree->n.sym->ts.type == BT_CLASS
!       && CLASS_DATA (expr->symtree->n.sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
        && expr->ref->next == NULL)
      return true;
  
    /* An allocatable variable.  */
!   if (expr->symtree->n.sym->attr.allocatable
  	&& expr->ref
  	&& expr->ref->type == REF_ARRAY
  	&& expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
!   if ((expr->symtree->n.sym->ts.type != BT_DERIVED
!        && expr->symtree->n.sym->ts.type != BT_CLASS)
! 	|| !expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
      return false;
  
    /* Find a component ref followed by an array reference.  */
--- 9470,9501 ----
  gfc_is_reallocatable_lhs (gfc_expr *expr)
  {
    gfc_ref * ref;
+   gfc_symbol *sym;
  
    if (!expr->ref)
      return false;
  
+   sym = expr->symtree->n.sym;
+ 
    /* An allocatable class variable with no reference.  */
!   if (sym->ts.type == BT_CLASS
!       && CLASS_DATA (sym)->attr.allocatable
        && expr->ref && expr->ref->type == REF_COMPONENT
        && strcmp (expr->ref->u.c.component->name, "_data") == 0
        && expr->ref->next == NULL)
      return true;
  
    /* An allocatable variable.  */
!   if (sym->attr.allocatable
  	&& expr->ref
  	&& expr->ref->type == REF_ARRAY
  	&& expr->ref->u.ar.type == AR_FULL)
      return true;
  
    /* All that can be left are allocatable components.  */
!   if ((sym->ts.type != BT_DERIVED
!        && sym->ts.type != BT_CLASS)
! 	|| !sym->ts.u.derived->attr.alloc_comp)
      return false;
  
    /* Find a component ref followed by an array reference.  */
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 257682)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_derived_to_class (gfc_se *parms
*** 657,663 ****
  	      }
  
  	  /* Array references with vector subscripts and non-variable expressions
! 	     need be coverted to a one-based descriptor.  */
  	  if (ref || e->expr_type != EXPR_VARIABLE)
  	    {
  	      for (dim = 0; dim < e->rank; ++dim)
--- 657,663 ----
  	      }
  
  	  /* Array references with vector subscripts and non-variable expressions
! 	     need be converted to a one-based descriptor.  */
  	  if (ref || e->expr_type != EXPR_VARIABLE)
  	    {
  	      for (dim = 0; dim < e->rank; ++dim)
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 257682)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1926,1934 ****
--- 1926,1951 ----
      {
        gfc_expr *lhs;
        tree res;
+       gfc_se se;
+ 
+       gfc_init_se (&se, NULL);
+ 
+       /* resolve.c converts some associate names to allocatable so that
+ 	 allocation can take place automatically in gfc_trans_assignment.
+ 	 The frontend prevents them from being either allocated,
+ 	 deallocated or reallocated.  */
+       if (sym->attr.allocatable)
+ 	{
+ 	  tmp = sym->backend_decl;
+ 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ 	    tmp = gfc_conv_descriptor_data_get (tmp);
+ 	  gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
+ 						    null_pointer_node));
+ 	}
  
        lhs = gfc_lval_expr_from_sym (sym);
        res = gfc_trans_assignment (lhs, e, false, true);
+       gfc_add_expr_to_block (&se.pre, res);
  
        tmp = sym->backend_decl;
        if (e->expr_type == EXPR_FUNCTION
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1948,1955 ****
--- 1965,1989 ----
  	  tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)->ts.u.derived,
  					 tmp, 0);
  	}
+       else if (sym->attr.allocatable)
+ 	{
+ 	  tmp = sym->backend_decl;
+ 
+ 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ 	    tmp = gfc_conv_descriptor_data_get (tmp);
+ 
+ 	  /* A simple call to free suffices here.  */
+ 	  tmp = gfc_call_free (tmp);
+ 
+ 	  /* Make sure that reallocation on assignment cannot occur.  */
+ 	  sym->attr.allocatable = 0;
+ 	}
+       else
+ 	tmp = NULL_TREE;
  
+       res = gfc_finish_block (&se.pre);
        gfc_add_init_cleanup (block, res, tmp);
+       gfc_free_expr (lhs);
      }
  
    /* Set the stringlength, when needed.  */
Index: gcc/testsuite/gfortran.dg/associate_35.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_35.f90	(revision 257682)
--- gcc/testsuite/gfortran.dg/associate_35.f90	(working copy)
***************
*** 1,6 ****
! ! { dg-do compile }
  !
! ! Test the fix for PR84115 comment #1 (except for s1(x)!).
  !
  ! Contributed by G Steinmetz  <gscfq@t-online.de>
  !
--- 1,6 ----
! ! { dg-do run }
  !
! ! Test the fix for PR84115 comment #1.
  !
  ! Contributed by G Steinmetz  <gscfq@t-online.de>
  !
***************
*** 14,35 ****
  contains
    subroutine s1(x)
      character(:), allocatable :: x
!     associate (y => x//x)   ! { dg-error "type character and non-constant length" }
!       print *, y
      end associate
    end
  
    subroutine s2(x)
      character(:), allocatable :: x
      associate (y => [x])
!       print *, y
      end associate
    end
  
    subroutine s3(x)
      character(:), allocatable :: x
      associate (y => [x,x])
!       print *, y
      end associate
    end
  end
--- 14,35 ----
  contains
    subroutine s1(x)
      character(:), allocatable :: x
!     associate (y => x//x)
!       if (y .ne. x//x) stop 1
      end associate
    end
  
    subroutine s2(x)
      character(:), allocatable :: x
      associate (y => [x])
!       if (any(y .ne. [x])) stop 2
      end associate
    end
  
    subroutine s3(x)
      character(:), allocatable :: x
      associate (y => [x,x])
!       if (any(y .ne. [x,x])) stop 3
      end associate
    end
  end