From 8b16d23143dd296aa30177b762552c9cd7f472ed Mon Sep 17 00:00:00 2001 From: "Christopher D. Rickett" Date: Mon, 23 Jul 2007 09:03:30 +0000 Subject: [PATCH] re PR fortran/32732 ([Bind C] Character scalars are passed as arrays) 2007-07-23 Christopher D. Rickett PR fortran/32732 * trans-decl.c (generate_local_decl): Convert the TREE_TYPE for by value character dummy args of BIND(C) procedures. * trans-expr.c (gfc_conv_variable): Do not build address expression for BT_CHARACTER dummy args. 2007-07-23 Christopher D. Rickett PR fortran/32732 * gfortran.dg/c_char_tests.f03: New test case. * gfortran.dg/c_char_driver.c: Driver for c_char_tests.f03. * gfortran.dg/c_char_tests_2.f03: New test case. * gfortran.dg/value_6.f03: Ditto. * gfortran.dg/value_7.f03: Ditto. From-SVN: r126836 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/trans-decl.c | 13 ++++++++ gcc/fortran/trans-expr.c | 5 --- gcc/testsuite/ChangeLog | 9 ++++++ gcc/testsuite/gfortran.dg/c_char_driver.c | 14 +++++++++ gcc/testsuite/gfortran.dg/c_char_tests.f03 | 29 +++++++++++++++++ gcc/testsuite/gfortran.dg/c_char_tests_2.f03 | 33 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/value_6.f03 | 25 +++++++++++++++ gcc/testsuite/gfortran.dg/value_7.f03 | 22 +++++++++++++ 9 files changed, 153 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_char_driver.c create mode 100644 gcc/testsuite/gfortran.dg/c_char_tests.f03 create mode 100644 gcc/testsuite/gfortran.dg/c_char_tests_2.f03 create mode 100644 gcc/testsuite/gfortran.dg/value_6.f03 create mode 100644 gcc/testsuite/gfortran.dg/value_7.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8db51b8bb41..93f52770df7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-07-23 Christopher D. Rickett + + PR fortran/32732 + * trans-decl.c (generate_local_decl): Convert the TREE_TYPE for by + value character dummy args of BIND(C) procedures. + * trans-expr.c (gfc_conv_variable): Do not build address + expression for BT_CHARACTER dummy args. + 2007-07-23 Christopher D. Rickett Tobias Burnus diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e07fba4209a..0acd5f8c14f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3018,6 +3018,19 @@ generate_local_decl (gfc_symbol * sym) &sym->declared_at); } + if (sym->attr.dummy == 1) + { + /* Modify the tree type for scalar character dummy arguments of bind(c) + procedures if they are passed by value. The tree type for them will + be promoted to INTEGER_TYPE for the middle end, which appears to be + what C would do with characters passed by-value. The value attribute + implies the dummy is a scalar. */ + if (sym->attr.value == 1 && sym->backend_decl != NULL + && sym->ts.type == BT_CHARACTER && sym->ts.is_c_interop + && sym->ns->proc_name != NULL && sym->ns->proc_name->attr.is_bind_c) + TREE_TYPE (sym->backend_decl) = unsigned_char_type_node; + } + /* Make sure we convert the types of the derived types from iso_c_binding into (void *). */ if (sym->attr.flavor != FL_PROCEDURE && sym->attr.is_iso_c diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1446d2b28f7..898a62630bc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -472,11 +472,6 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) || sym->attr.result)) se->expr = build_fold_indirect_ref (se->expr); - /* A character with VALUE attribute needs an address - expression. */ - if (sym->attr.value) - se->expr = build_fold_addr_expr (se->expr); - } else if (!sym->attr.value) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 54cc7acbeff..5f21f1bd03c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2007-07-23 Christopher D. Rickett + + PR fortran/32732 + * gfortran.dg/c_char_tests.f03: New test case. + * gfortran.dg/c_char_driver.c: Driver for c_char_tests.f03. + * gfortran.dg/c_char_tests_2.f03: New test case. + * gfortran.dg/value_6.f03: Ditto. + * gfortran.dg/value_7.f03: Ditto. + 2007-07-23 Christopher D. Rickett PR fortran/32600 diff --git a/gcc/testsuite/gfortran.dg/c_char_driver.c b/gcc/testsuite/gfortran.dg/c_char_driver.c new file mode 100644 index 00000000000..ca41ab1ed73 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_char_driver.c @@ -0,0 +1,14 @@ +void param_test(char my_char, char my_char_2); +void sub0(void); +void sub1(char *my_char); + +int main(int argc, char **argv) +{ + char my_char = 'y'; + + param_test('y', 'z'); + sub0(); + sub1(&my_char); + + return 0; +} diff --git a/gcc/testsuite/gfortran.dg/c_char_tests.f03 b/gcc/testsuite/gfortran.dg/c_char_tests.f03 new file mode 100644 index 00000000000..72b136e01d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_char_tests.f03 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-additional-sources c_char_driver.c } +! Verify that character dummy arguments for bind(c) procedures can work both +! by-value and by-reference when called by either C or Fortran. +! PR fortran/32732 +module c_char_tests + use, intrinsic :: iso_c_binding, only: c_char + implicit none +contains + subroutine param_test(my_char, my_char_2) bind(c) + character(c_char), value :: my_char + character(c_char), value :: my_char_2 + if(my_char /= c_char_'y') call abort() + if(my_char_2 /= c_char_'z') call abort() + + call sub1(my_char) + end subroutine param_test + + subroutine sub0() bind(c) + call param_test('y', 'z') + end subroutine sub0 + + subroutine sub1(my_char_ref) bind(c) + character(c_char) :: my_char_ref + if(my_char_ref /= c_char_'y') call abort() + end subroutine sub1 +end module c_char_tests + +! { dg-final { cleanup-modules "c_char_tests" } } diff --git a/gcc/testsuite/gfortran.dg/c_char_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_char_tests_2.f03 new file mode 100644 index 00000000000..4e5edb085d1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_char_tests_2.f03 @@ -0,0 +1,33 @@ +! { dg-do run } +! Verify that the changes made to character dummy arguments for bind(c) +! procedures doesn't break non-bind(c) routines. +! PR fortran/32732 +subroutine bar(a) + use, intrinsic :: iso_c_binding, only: c_char + character(c_char), value :: a + if(a /= c_char_'a') call abort() +end subroutine bar + +subroutine bar2(a) + use, intrinsic :: iso_c_binding, only: c_char + character(c_char) :: a + if(a /= c_char_'a') call abort() +end subroutine bar2 + +use iso_c_binding +implicit none +interface + subroutine bar(a) + import + character(c_char),value :: a + end subroutine bar + subroutine bar2(a) + import + character(c_char) :: a + end subroutine bar2 +end interface + character(c_char) :: z + z = 'a' + call bar(z) + call bar2(z) +end diff --git a/gcc/testsuite/gfortran.dg/value_6.f03 b/gcc/testsuite/gfortran.dg/value_6.f03 new file mode 100644 index 00000000000..0650d3295b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/value_6.f03 @@ -0,0 +1,25 @@ +! { dg-do run } +! Verify by-value passing of character arguments w/in Fortran to a bind(c) +! procedure. +! PR fortran/32732 +module pr32732 + use, intrinsic :: iso_c_binding, only: c_char + implicit none +contains + subroutine test(a) bind(c) + character(kind=c_char), value :: a + call test2(a) + end subroutine test + subroutine test2(a) bind(c) + character(kind=c_char), value :: a + if(a /= c_char_'a') call abort () + print *, 'a=',a + end subroutine test2 +end module pr32732 + +program main + use pr32732 + implicit none + call test('a') +end program main +! { dg-final { cleanup-modules "pr32732" } } diff --git a/gcc/testsuite/gfortran.dg/value_7.f03 b/gcc/testsuite/gfortran.dg/value_7.f03 new file mode 100644 index 00000000000..24395778ec7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/value_7.f03 @@ -0,0 +1,22 @@ +! { dg-do run } +! Test passing character strings by-value. +! PR fortran/32732 +program test + implicit none + character(len=13) :: chr + chr = 'Fortran ' + call sub1(chr) + if(chr /= 'Fortran ') call abort() +contains + subroutine sub1(a) + character(len=13), VALUE :: a + a = trim(a)//" rules" + call sub2(a) + end subroutine sub1 + subroutine sub2(a) + character(len=13), VALUE :: a + print *, a + if(a /= 'Fortran rules') call abort() + end subroutine sub2 +end program test + -- 2.30.2