OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/34246 (gfortran.dg/bind_c_usage_16.f03 doesn't work)

Browse Source 
2007-12-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34246
        * trans-types.c (gfc_init_types): Change build_type_variant
        to build_qualified_type.
        (gfc_sym_type): Return gfc_character1_type_node for
        character-returning bind(C) functions.
        * trans-expr.c (gfc_conv_function_call): Do not set
        se->string_length for character-returning bind(c) functions.
        (gfc_trans_string_copy,gfc_trans_scalar_assign):
         Support also single characters.

2007-12-16  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34246
        * gfortran.dg/bind_c_usage_16.f03: Extend test.

From-SVN: r130991
This commit is contained in:
Tobias Burnus 2007-12-16 21:24:32 +01:00 committed by Tobias Burnus
parent ac8bb1ec43
commit 06a54338c4
5 changed files with 85 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
2007-12-16 Tobias Burnus <burnus@net-b.de>
PR fortran/34246
* trans-types.c (gfc_init_types): Change build_type_variant
to build_qualified_type.
(gfc_sym_type): Return gfc_character1_type_node for
character-returning bind(C) functions.
* trans-expr.c (gfc_conv_function_call): Do not set
se->string_length for character-returning bind(c) functions.
(gfc_trans_string_copy,gfc_trans_scalar_assign):
Support also single characters.
2007-12-16 Bernhard Fischer <aldot@gcc.gnu.org>
* errors.c (gfc_notify_std): As originally stated but improperly

78
gcc/fortran/trans-expr.c
View File

@ -2559,7 +2559,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
ts = sym->ts;
if (ts.type == BT_CHARACTER)
if (ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
{
if (sym->ts.cl->length == NULL)
{
@ -2736,15 +2736,6 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
&& !sym->attr.always_explicit)
se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
/* Bind(C) character variables may have only length 1. */
if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c)
{
gcc_assert (sym->ts.cl->length
&& sym->ts.cl->length->expr_type == EXPR_CONSTANT
&& mpz_cmp_si (sym->ts.cl->length->value.integer, 1) == 0);
se->string_length = build_int_cst (gfc_charlen_type_node, 1);
}
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;
@ -2820,12 +2811,34 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
tree tmp4;
stmtblock_t tempblock;
dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block));
slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block));
if (slength != NULL_TREE)
{
slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block));
ssc = gfc_to_single_character (slen, src);
}
else
{
slen = build_int_cst (size_type_node, 1);
ssc = src;
}
if (dlength != NULL_TREE)
{
dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block));
dsc = gfc_to_single_character (slen, dest);
}
else
{
dlen = build_int_cst (size_type_node, 1);
dsc = dest;
}
if (slength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (src)))
ssc = gfc_to_single_character (slen, src);
if (dlength != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (dest)))
dsc = gfc_to_single_character (dlen, dest);
/* Deal with single character specially. */
dsc = gfc_to_single_character (dlen, dest);
ssc = gfc_to_single_character (slen, src);
if (dsc != NULL_TREE && ssc != NULL_TREE)
{
gfc_add_modify_expr (block, dsc, ssc);
@ -2859,8 +2872,15 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
We're now doing it here for better optimization, but the logic
is the same. */
dest = fold_convert (pvoid_type_node, dest);
src = fold_convert (pvoid_type_node, src);
if (dlength)
dest = fold_convert (pvoid_type_node, dest);
else
dest = gfc_build_addr_expr (pvoid_type_node, dest);
if (slength)
src = fold_convert (pvoid_type_node, src);
else
src = gfc_build_addr_expr (pvoid_type_node, src);
/* Truncate string if source is too long. */
cond2 = fold_build2 (GE_EXPR, boolean_type_node, slen, dlen);
@ -3806,17 +3826,25 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
if (ts.type == BT_CHARACTER)
{
gcc_assert (lse->string_length != NULL_TREE
&& rse->string_length != NULL_TREE);
tree rlen = NULL;
tree llen = NULL;
gfc_conv_string_parameter (lse);
gfc_conv_string_parameter (rse);
if (lse->string_length != NULL_TREE)
{
gfc_conv_string_parameter (lse);
gfc_add_block_to_block (&block, &lse->pre);
llen = lse->string_length;
}
gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre);
if (rse->string_length != NULL_TREE)
{
gcc_assert (rse->string_length != NULL_TREE);
gfc_conv_string_parameter (rse);
gfc_add_block_to_block (&block, &rse->pre);
rlen = rse->string_length;
}
gfc_trans_string_copy (&block, lse->string_length, lse->expr,
rse->string_length, rse->expr);
gfc_trans_string_copy (&block, llen, lse->expr, rlen, rse->expr);
}
else if (ts.type == BT_DERIVED && ts.derived->attr.alloc_comp)
{

10
gcc/fortran/trans-types.c
View File

@ -717,8 +717,8 @@ gfc_init_types (void)
PUSH_TYPE (name_buf, type);
}
gfc_character1_type_node = build_type_variant (unsigned_char_type_node,
0, 0);
gfc_character1_type_node = build_qualified_type (unsigned_char_type_node,
TYPE_UNQUALIFIED);
PUSH_TYPE ("character(kind=1)", gfc_character1_type_node);
PUSH_TYPE ("byte", unsigned_char_type_node);
@ -1555,7 +1555,11 @@ gfc_sym_type (gfc_symbol * sym)
if (sym->backend_decl && !sym->attr.function)
return TREE_TYPE (sym->backend_decl);
type = gfc_typenode_for_spec (&sym->ts);
if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c
&& (sym->attr.function || sym->attr.result))
type = gfc_character1_type_node;
else
type = gfc_typenode_for_spec (&sym->ts);
if (sym->attr.dummy && !sym->attr.function && !sym->attr.value)
byref = 1;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-16 Tobias Burnus <burnus@net-b.de>
PR fortran/34246
* gfortran.dg/bind_c_usage_16.f03: Extend test.
2007-12-16 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31213

11
gcc/testsuite/gfortran.dg/bind_c_usage_16.f03
View File

@ -24,9 +24,11 @@ subroutine test() bind(c)
use mod
implicit none
character(len=1,kind=c_char) :: a
character(len=5,kind=c_char) :: b
character(len=3,kind=c_char) :: b
character(len=1,kind=c_char) :: c(3)
character(len=5,kind=c_char) :: d(3)
character(len=3,kind=c_char) :: d(3)
integer :: i
a = 'z'
b = 'fffff'
c = 'h'
@ -35,7 +37,7 @@ subroutine test() bind(c)
a = bar('x')
if (a /= 'A') call abort()
b = bar('y')
if (b /= 'A') call abort()
if (b /= 'A' .or. iachar(b(2:2))/=32 .or. iachar(b(3:3))/=32) call abort()
c = bar('x')
if (any(c /= 'A')) call abort()
d = bar('y')
@ -49,4 +51,7 @@ subroutine test() bind(c)
if (any(c /= 'B')) call abort()
d = foo()
if (any(d /= 'B')) call abort()
do i = 1,3
if(iachar(d(i)(2:2)) /=32 .or. iachar(d(i)(3:3)) /= 32) call abort()
end do
end subroutine