PR fortran/59906
* trans-array.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-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/59906
* gfortran.dg/elemental_subroutine_9.f90 : New test
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@207617
138bc75d-0d04-0410-961f-
82ee72b054a4
+2014-02-08 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/59906
+ * trans-array.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-03 Janus Weil <janus@gcc.gnu.org>
PR fortran/59941
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))
/* Returns a reference to the scalar evaluated outside the loop
for this case. */
gfc_conv_expr (se, expr);
- se->expr = gfc_build_addr_expr (NULL_TREE, 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;
}
+2014-02-08 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/59906
+ * gfortran.dg/elemental_subroutine_9.f90 : New test
+
2014-02-04 Uros Bizjak <ubizjak@gmail.com>
Backport from mainline
--- /dev/null
+! { 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