2013-05-04 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 4 May 2013 17:49:31 +0000 (17:49 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 4 May 2013 17:49:31 +0000 (17:49 +0000)
        * decl.c (gfc_verify_c_interop_param): Permit allocatable
        and pointer with -std=f2008ts.

2013-05-04  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/bind_c_array_params.f03: Update dg-error.
        * gfortran.dg/bind_c_usage_27.f90: New.
        * gfortran.dg/bind_c_usage_28.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198597 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/bind_c_array_params.f03
gcc/testsuite/gfortran.dg/bind_c_usage_27.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bind_c_usage_28.f90 [new file with mode: 0644]

index c523473..3b8fe53 100644 (file)
@@ -1,3 +1,8 @@
+2013-05-04  Tobias Burnus  <burnus@net-b.de>
+
+       * decl.c (gfc_verify_c_interop_param): Permit allocatable
+       and pointer with -std=f2008ts.
+
 2013-05-02  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57142
index f9891c9..0187911 100644 (file)
@@ -1061,20 +1061,27 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
          /* We have to make sure that any param to a bind(c) routine does
             not have the allocatable, pointer, or optional attributes,
             according to J3/04-007, section 5.1.  */
-         if (sym->attr.allocatable == 1)
-           {
-             gfc_error ("Variable '%s' at %L cannot have the "
-                        "ALLOCATABLE attribute because procedure '%s'"
-                        " is BIND(C)", sym->name, &(sym->declared_at),
-                        sym->ns->proc_name->name);
-             retval = false;
-           }
+         if (sym->attr.allocatable == 1
+             && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with "
+                                 "ALLOCATABLE attribute in procedure '%s' "
+                                 "with BIND(C)", sym->name,
+                                 &(sym->declared_at),
+                                 sym->ns->proc_name->name))
+           retval = false;
+
+         if (sym->attr.pointer == 1
+             && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with "
+                                 "POINTER attribute in procedure '%s' "
+                                 "with BIND(C)", sym->name,
+                                 &(sym->declared_at),
+                                 sym->ns->proc_name->name))
+           retval = false;
 
-         if (sym->attr.pointer == 1)
+         if ((sym->attr.allocatable || sym->attr.pointer) && !sym->as)
            {
-             gfc_error ("Variable '%s' at %L cannot have the "
-                        "POINTER attribute because procedure '%s'"
-                        " is BIND(C)", sym->name, &(sym->declared_at),
+             gfc_error ("Scalar variable '%s' at %L with POINTER or "
+                        "ALLOCATABLE in procedure '%s' with BIND(C) is not yet"
+                        " supported", sym->name, &(sym->declared_at),
                         sym->ns->proc_name->name);
              retval = false;
            }
index 1d684ea..2e0d510 100644 (file)
@@ -1,3 +1,9 @@
+2013-05-04  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/bind_c_array_params.f03: Update dg-error.
+       * gfortran.dg/bind_c_usage_27.f90: New.
+       * gfortran.dg/bind_c_usage_28.f90: New.
+
 2013-05-04  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/51927
index 810f642..0e9903c 100644 (file)
@@ -9,7 +9,7 @@ contains
     integer(c_int), dimension(:) :: assumed_array
   end subroutine sub0
 
-  subroutine sub1(deferred_array) bind(c) ! { dg-error "cannot" } 
+  subroutine sub1(deferred_array) bind(c) ! { dg-error "TS 29113: Variable 'deferred_array' at .1. with POINTER attribute in procedure 'sub1' with BIND.C." }
     integer(c_int), pointer :: deferred_array(:)
   end subroutine sub1
 end module bind_c_array_params
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_27.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_27.f90
new file mode 100644 (file)
index 0000000..a1b0fcc
--- /dev/null
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2008ts" }
+!
+! Contributed by Reinhold Bader
+! 
+use iso_c_binding
+type, bind(C) :: cstruct
+  integer :: i
+end type
+interface
+     subroutine psub(this, that) bind(c, name='Psub')
+       import :: c_float, cstruct
+       real(c_float), pointer  :: this(:)
+       type(cstruct), allocatable  :: that(:)
+     end subroutine psub
+  end interface
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_28.f90
new file mode 100644 (file)
index 0000000..ff03ef4
--- /dev/null
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! Contributed by Reinhold Bader
+! 
+use iso_c_binding
+type, bind(C) :: cstruct
+  integer :: i
+end type
+interface
+     subroutine psub(this) bind(c, name='Psub') ! { dg-error "TS 29113: Variable 'this' at .1. with POINTER attribute in procedure 'psub' with BIND.C." }
+       import :: c_float, cstruct
+       real(c_float), pointer  :: this(:)
+     end subroutine psub
+     subroutine psub2(that) bind(c, name='Psub2') ! { dg-error "TS 29113: Variable 'that' at .1. with ALLOCATABLE attribute in procedure 'psub2' with BIND.C." }
+       import :: c_float, cstruct
+       type(cstruct), allocatable  :: that(:)
+     end subroutine psub2
+  end interface
+end