Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 253101)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_assoc_var (gfc_symbol* sym, bool
*** 8530,8536 ****
        if (!sym->ts.u.cl)
  	sym->ts.u.cl = target->ts.u.cl;

!       if (!sym->ts.u.cl->length)
  	sym->ts.u.cl->length
  	  = gfc_get_int_expr (gfc_default_integer_kind,
  			      NULL, target->value.character.length);
--- 8530,8536 ----
        if (!sym->ts.u.cl)
  	sym->ts.u.cl = target->ts.u.cl;

!       if (!sym->ts.u.cl->length && !sym->ts.deferred)
  	sym->ts.u.cl->length
  	  = gfc_get_int_expr (gfc_default_integer_kind,
  			      NULL, target->value.character.length);
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 253101)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_is_associate_pointer (gfc_symbol* sy
*** 5054,5059 ****
--- 5054,5065 ----
    if (sym->ts.type == BT_CLASS)
      return true;

+   if (sym->ts.type == BT_CHARACTER
+       && sym->ts.deferred
+       && sym->assoc->target
+       && sym->assoc->target->expr_type == EXPR_FUNCTION)
+     return true;
+
    if (!sym->assoc->variable)
      return false;

Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c	(revision 253101)
--- gcc/fortran/trans-decl.c	(working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1695,1700 ****
--- 1695,1708 ----
    if (sym->ts.type == BT_CHARACTER)
      {
        if (sym->attr.associate_var
+ 	  && sym->ts.deferred
+ 	  && sym->assoc && sym->assoc->target
+ 	  && ((sym->assoc->target->expr_type == EXPR_VARIABLE
+ 	       && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
+ 	      || sym->assoc->target->expr_type == EXPR_FUNCTION))
+ 	sym->ts.u.cl->backend_decl = NULL_TREE;
+
+       if (sym->attr.associate_var
  	  && sym->ts.u.cl->backend_decl
  	  && VAR_P (sym->ts.u.cl->backend_decl))
  	length = gfc_index_zero_node;
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 253101)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1533,1538 ****
--- 1533,1539 ----
    bool need_len_assign;
    bool whole_array = true;
    gfc_ref *ref;
+   symbol_attribute attr;

    gcc_assert (sym->assoc);
    e = sym->assoc->target;
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1592,1597 ****
--- 1593,1609 ----

        gfc_conv_expr_descriptor (&se, e);

+       if (sym->ts.type == BT_CHARACTER
+ 	  && sym->ts.deferred
+ 	  && !sym->attr.select_type_temporary
+ 	  && VAR_P (sym->ts.u.cl->backend_decl)
+ 	  && se.string_length != sym->ts.u.cl->backend_decl)
+ 	{
+ 	  gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
+ 			  fold_convert (gfc_charlen_type_node,
+ 					se.string_length));
+ 	}
+
        /* If we didn't already do the pointer assignment, set associate-name
  	 descriptor to the one generated for the temporary.  */
        if ((!sym->assoc->variable && !cst_array_ctor)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1758,1765 ****
  	  need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER;
  	}

!       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),
--- 1770,1804 ----
  	  need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER;
  	}

!       if (sym->ts.type == BT_CHARACTER
! 	  && sym->ts.deferred
! 	  && !sym->attr.select_type_temporary
! 	  && VAR_P (sym->ts.u.cl->backend_decl)
! 	  && se.string_length != sym->ts.u.cl->backend_decl)
! 	{
! 	  gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
! 			  fold_convert (gfc_charlen_type_node,
! 					se.string_length));
! 	  if (e->expr_type == EXPR_FUNCTION)
! 	    {
! 	      tmp = gfc_call_free (sym->backend_decl);
! 	      gfc_add_expr_to_block (&se.post, tmp);
! 	    }
! 	}
!
!       attr = gfc_expr_attr (e);
!       if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER
! 	  && (attr.allocatable || attr.pointer || attr.dummy))
! 	{
! 	  /* These are pointer types already.  */
! 	  tmp = fold_convert (TREE_TYPE (sym->backend_decl), se.expr);
! 	}
!       else
! 	{
!           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),
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1784,1790 ****
        gfc_init_se (&se, NULL);
        if (e->symtree->n.sym->ts.type == BT_CHARACTER)
  	{
! 	  /* What about deferred strings?  */
  	  gcc_assert (!e->symtree->n.sym->ts.deferred);
  	  tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
  	}
--- 1823,1829 ----
        gfc_init_se (&se, NULL);
        if (e->symtree->n.sym->ts.type == BT_CHARACTER)
  	{
! 	  /* Deferred strings are dealt with in the preceeding.  */
  	  gcc_assert (!e->symtree->n.sym->ts.deferred);
  	  tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
  	}
Index: gcc/testsuite/gfortran.dg/associate_32.f03
===================================================================
*** gcc/testsuite/gfortran.dg/associate_32.f03	(nonexistent)
--- gcc/testsuite/gfortran.dg/associate_32.f03	(working copy)
***************
*** 0 ****
--- 1,93 ----
+ ! { dg-do run }
+ !
+ ! Tests fix for PR77296 and other bugs found on the way.
+ !
+ ! Contributed by Matt Thompson  <matthew.thompson@nasa.gov>
+ !
+ program test
+
+    implicit none
+    type :: str_type
+      character(len=:), allocatable :: str
+    end type
+
+    character(len=:), allocatable :: s, sd(:)
+    character(len=2), allocatable :: sf, sfd(:)
+    character(len=6) :: str
+    type(str_type) :: string
+
+    s = 'ab'
+    associate(ss => s)
+      if (ss .ne. 'ab') call abort ! This is the original bug.
+      ss = 'c'
+    end associate
+    if (s .ne. 'c ') call abort ! No reallocation within ASSOCIATE block!
+
+    sf = 'c'
+    associate(ss => sf)
+      if (ss .ne. 'c ') call abort ! This the bug in comment #2 of the PR.
+      ss = 'cd'
+    end associate
+
+    sd = [s, sf]
+    associate(ss => sd)
+      if (any (ss .ne. ['c ','cd'])) call abort
+    end associate
+
+    sfd = [sd,'ef']
+    associate(ss => sfd)
+      if (any (ss .ne. ['c ','cd','ef'])) call abort
+      ss = ['gh']
+    end associate
+      if (any (sfd .ne. ['gh','cd','ef'])) call abort ! No reallocation!
+
+    string%str = 'xyz'
+    associate(ss => string%str)
+      if (ss .ne. 'xyz') call abort
+      ss = 'c'
+    end associate
+    if (string%str .ne. 'c  ') call abort ! No reallocation!
+
+    str = "foobar"
+    call test_char (5 , str)
+    IF (str /= "abcder") call abort
+
+    associate(ss => foo())
+      if (ss .ne. 'pqrst') call abort
+    end associate
+
+    associate(ss => bar())
+      if (ss(2) .ne. 'uvwxy') call abort
+    end associate
+
+ ! The deallocation is not strictly necessary but it does allow
+ ! other memory leakage to be tested for.
+    deallocate (s, sd, sf, sfd, string%str)
+ contains
+
+ ! This is a modified version of the subroutine in associate_1.f03.
+ ! 'str' is now a dummy.
+   SUBROUTINE test_char (n, str)
+     INTEGER, INTENT(IN) :: n
+
+     CHARACTER(LEN=n) :: str
+
+     ASSOCIATE (my => str)
+       IF (LEN (my) /= n) call abort
+       IF (my /= "fooba") call abort
+       my = "abcde"
+     END ASSOCIATE
+     IF (str /= "abcde") call abort
+   END SUBROUTINE test_char
+
+    function foo() result(res)
+      character (len=:), pointer :: res
+      allocate (res, source = 'pqrst')
+    end function
+
+    function bar() result(res)
+      character (len=:), allocatable :: res(:)
+      allocate (res, source = ['pqrst','uvwxy'])
+    end function
+
+ end program test