re PR fortran/32732 ([Bind C] Character scalars are passed as arrays)

2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>

       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  <crickett@lanl.gov>

       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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8db51b8..93f5277 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,12 @@
 2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
+
+       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  <crickett@lanl.gov>
            Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/32600

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e07fba4..0acd5f8 100644 (file)
--- 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 1446d2b..898a626 100644 (file)
--- 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 54cc7ac..5f21f1b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,14 @@
 2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
 
+       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  <crickett@lanl.gov>
+
        PR fortran/32600
        * gfortran.dg/c_funloc_tests_5.f03: New.
        * gfortran.dg/c_funloc_tests_5.f04: New.

diff --git a/gcc/testsuite/gfortran.dg/c_char_driver.c b/gcc/testsuite/gfortran.dg/c_char_driver.c
new file mode 100644 (file)
index 0000000..ca41ab1
--- /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 (file)
index 0000000..72b136e
--- /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 (file)
index 0000000..4e5edb0
--- /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 (file)
index 0000000..0650d32
--- /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 (file)
index 0000000..2439577
--- /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
+