Comments
Patch
2010-12-07 Tobias Burnus <burnus@net-b.de>
PR fortran/44352
* trans-expr.c (gfc_string_to_single_character): Return if not
POINTER_TYPE_P.
(gfc_trans_string_copy): gfc_build_addr_expr if src is not a
pointer.
2010-12-07 Tobias Burnus <burnus@net-b.de>
PR fortran/44352
* gfortran.dg/string_4.f90: New.
@@ -1438,9 +1438,9 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
tree
gfc_string_to_single_character (tree len, tree str, int kind)
{
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (str)));
- if (!INTEGER_CST_P (len) || TREE_INT_CST_HIGH (len) != 0)
+ if (!INTEGER_CST_P (len) || TREE_INT_CST_HIGH (len) != 0
+ || !POINTER_TYPE_P (TREE_TYPE (str)))
return NULL_TREE;
if (TREE_INT_CST_LOW (len) == 1)
@@ -3831,7 +3831,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
else
dest = gfc_build_addr_expr (pvoid_type_node, dest);
- if (slength)
+ if (slength && POINTER_TYPE_P (TREE_TYPE (src)))
src = fold_convert (pvoid_type_node, src);
else
src = gfc_build_addr_expr (pvoid_type_node, src);
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "" }
+! (options to disable warnings about statement functions etc.)
+!
+! PR fortran/44352
+!
+! Contributed by Vittorio Zecca
+!
+
+ SUBROUTINE TEST1()
+ implicit real*8 (a-h,o-z)
+ character*32 ddname,stmtfnt1
+ stmtfnt1(x)= 'h810 e=0.01 '
+ ddname=stmtfnt1(0.d0)
+ if (ddname /= "h810 e=0.01") call abort()
+ END
+
+ SUBROUTINE TEST2()
+ implicit none
+ character(2) :: ddname,stmtfnt2
+ real :: x
+ stmtfnt2(x)= 'x'
+ ddname=stmtfnt2(0.0)
+ if(ddname /= 'x') call abort()
+ END
+
+ call test1()
+ call test2()
+ end