[Patch, fortran] PR49906 [4.7/4.8/4.9 Regression] error: size of variable '<anonymous>' is too large

[Paul Richard Thomas]

Dear All,

This regression was flagged by Harald and the trigger, r158683, was
identified by HJ.  Many thanks to both.  It surprises me that the bug
has lain dormant for so long.

The fix is fortunately relatively simple. CHARACTER scalars are, in
fact arrays in one shape or form and so using them as an SS_REFERENCE
is bound to fail unless a pointer to the array is stored in the outer
loop and passed to the ELEMENTAL subroutine/function.
gfc_conv_string_parameter is equipped to convert CHARACTERs in all
their manifestations into a pointer, so I have used this.  It does not
work correctly for function results, so this case has been excluded.

Not only does this patch bootstrap and regtest on FC17/x86_64 but all
the tests in ISO_VARYING_STRING run correctly.  This latter is
important because the suite makes heavy use of elemental functions
with character arguments.

OK for trunk and, with a decent delay, 4.7 and 4.8?

Cheers

Paul

2014-02-01  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/59906
    * trans-stmt.c (gfc_add_loop_ss_code): In the case of character
    SS_REFERENCE, use gfc_conv_string_parameter to ensure that a
    pointer to the string is stored.
    * trans-expr.c (gfc_conv_expr_reference): Likewise, use
    gfc_conv_string_parameter to ensure that a pointer to is passed
    to the elemental function.

2014-02-01  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/59906
    * gfortran.dg/elemental_subroutine_9.f90 : New test
-------------- next part --------------
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 207203)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2491,2496 ****
--- 2491,2501 ----
  		 a reference to the value.  */
  	      gfc_conv_expr (&se, expr);
  	    }
+ 
+ 	  /* Ensure that a pointer to the string is stored.  */
+ 	  if (expr->ts.type == BT_CHARACTER)
+ 	    gfc_conv_string_parameter (&se);
+ 
  	  gfc_add_block_to_block (&outer_loop->pre, &se.pre);
  	  gfc_add_block_to_block (&outer_loop->post, &se.post);
  	  if (gfc_is_class_scalar_expr (expr))
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 207203)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_expr_reference (gfc_se * se, gf
*** 6350,6356 ****
--- 6350,6362 ----
        /* Returns a reference to the scalar evaluated outside the loop
  	 for this case.  */
        gfc_conv_expr (se, expr);
+ 
+       if (expr->ts.type == BT_CHARACTER
+ 	  && expr->expr_type != EXPR_FUNCTION)
+ 	gfc_conv_string_parameter (se);
+       else
  	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+ 
        return;
      }
  
Index: gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90	(working copy)
***************
*** 0 ****
--- 1,39 ----
+ ! { dg-do run }
+ !
+ ! PR fortran/59906
+ !
+ ! Contributed by H Anlauf  <anlauf@gmx.de>
+ !
+ ! Failed generate character scalar for scalarized loop for elemantal call.
+ !
+ program x
+   implicit none
+   call y('bbb')
+ contains
+ 
+   subroutine y(str)
+     character(len=*), intent(in) :: str
+     character(len=len_trim(str)) :: str_aux
+     character(len=3) :: str3 = 'abc'
+ 
+     str_aux = str
+ 
+     ! Compiled but did not give correct result
+     if (any (str_cmp((/'aaa','bbb'/), str) .neqv. [.FALSE.,.TRUE.])) call abort
+ 
+     ! Did not compile
+     if (any (str_cmp((/'bbb', 'aaa'/), str_aux) .neqv. [.TRUE.,.FALSE.])) call abort
+ 
+     ! Verify patch
+     if (any (str_cmp((/'bbb', 'aaa'/), str3) .neqv. [.FALSE.,.FALSE.])) call abort
+     if (any (str_cmp((/'bbb', 'aaa'/), 'aaa') .neqv. [.FALSE.,.TRUE.])) call abort
+ 
+   end subroutine y
+ 
+   elemental logical function str_cmp(str1, str2)
+     character(len=*), intent(in) :: str1
+     character(len=*), intent(in) :: str2
+     str_cmp = (str1 == str2)
+   end function str_cmp
+ 
+ end program x