2018-02-19 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/83344
	PR fortran/83975
	* resolve.c (resolve_assoc_var): Rearrange the logic for the
	determination of the character length of associate names. If
	the associate name is missing a length expression or the length
	expression is not a constant and the target is not a variable,
	make the associate name allocatable and deferred length.
	* trans-decl.c (gfc_get_symbol_decl): Null the character length
	backend_decl for deferred length associate names that are not
	variables. Set 'length' to gfc_index_zero_node for character
	associate names, whose character length is a PARM_DECL.

2018-02-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/83344
	PR fortran/83975
	* gfortran.dg/associate_22.f90: Enable commented out test.
	* gfortran.dg/associate_36.f90: New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@257827 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog

@@ -1,3 +1,17 @@
+2018-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/83344
+	PR fortran/83975
+	* resolve.c (resolve_assoc_var): Rearrange the logic for the
+	determination of the character length of associate names. If
+	the associate name is missing a length expression or the length
+	expression is not a constant and the target is not a variable,
+	make the associate name allocatable and deferred length.
+	* trans-decl.c (gfc_get_symbol_decl): Null the character length
+	backend_decl for deferred length associate names that are not
+	variables. Set 'length' to gfc_index_zero_node for character
+	associate names, whose character length is a PARM_DECL.
+
 2018-02-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/35339

gcc/fortran/resolve.c

@@ -8635,30 +8635,26 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   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;
+	sym->ts.u.cl = target->ts.u.cl;
 
-	      /* 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
+	  && target->expr_type == EXPR_CONSTANT)
+	{
+	  sym->ts.u.cl->length =
+		gfc_get_int_expr (gfc_charlen_int_kind, NULL,
+				  target->value.character.length);
 	}
-
-      if (!sym->ts.u.cl->length && !sym->ts.deferred)
+      else if ((!sym->ts.u.cl->length
+		|| sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+		&& target->expr_type != EXPR_VARIABLE)
 	{
-	  if (target->expr_type == EXPR_CONSTANT)
-	    sym->ts.u.cl->length =
-	      gfc_get_int_expr (gfc_charlen_int_kind, NULL,
-				target->value.character.length);
-	  else
-	    gfc_error ("Not Implemented: Associate target with type character"
-		       " and non-constant length at %L", &target->where);
+	  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;
 	}
     }
 

gcc/fortran/trans-decl.c

@@ -1707,12 +1707,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && 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->assoc->target->expr_type != EXPR_VARIABLE))
 	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))
+	  && (VAR_P (sym->ts.u.cl->backend_decl)
+	      || TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL))
 	length = gfc_index_zero_node;
       else
 	length = gfc_create_string_length (sym);

gcc/testsuite/ChangeLog

@@ -1,3 +1,10 @@
+2018-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/83344
+	PR fortran/83975
+	* gfortran.dg/associate_22.f90: Enable commented out test.
+	* gfortran.dg/associate_36.f90: New test.
+
 2018-02-19  Jakub Jelinek  <jakub@redhat.com>
 
 	PR target/84146

gcc/testsuite/gfortran.dg/associate_22.f90

@@ -24,11 +24,10 @@ program foo
    end associate
 
    ! This failed.
-   ! This still doesn't work correctly, see PR 83344
-!   a = trim(s) // 'abc'
-!   associate(w => trim(s) // 'abc')
-!      if (trim(w) /= trim(a)) STOP 4
-!   end associate
+   a = trim(s) // 'abc'
+   associate(w => trim(s) // 'abc')
+      if (trim(w) /= trim(a)) STOP 4
+   end associate
 
    ! This failed.
    associate(x => trim('abc'))

gcc/testsuite/gfortran.dg/associate_36.f90

@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test the fix for PR83344.
+!
+! Contributed by <Janne Blomqvist  <jb@gcc.gnu.org>
+!
+program foo
+   implicit none
+   character(len=1) a
+   character(len=2) b
+   character(len=3) c
+   a = 'a'
+   call bah(a, len (a))
+   b = 'bb'
+   call bah(b, len (b))
+   c = 'ccc'
+   call bah(c, len (c))
+   contains
+      subroutine bah(x, clen)
+         implicit none
+         integer :: clen
+         character(len=*), intent(in) :: x
+         associate(y => x)
+            if (len(y) .ne. clen) stop 1
+            if (y .ne. x) stop 2
+         end associate
+      end subroutine bah
+end program foo