This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
updated testcase for fortran-experiments branch
- From: "Christopher D. Rickett" <crickett at lanl dot gov>
- To: fortran at gcc dot gnu dot org
- Date: Thu, 11 Jan 2007 12:47:01 -0700 (MST)
- Subject: updated testcase for fortran-experiments branch
here is an updated testcase for the fortran-experiments branch.
c_ptr_tests.f90 has been renamed to c_ptr_tests.f03 and updated to include
usage of c_null_ptr. regtested on x86.
Chris
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (revision 120681)
+++ gcc/testsuite/ChangeLog (working copy)
@@ -1,3 +1,11 @@
+2007-01-11 Christopher D. Rickett <crickett@lanl.gov>
+ * gfortran.dg/c_ptr_tests.f90: Renamed to c_ptr_test.f03
+ * gfortran.dg/c_ptr_tests.f03: Changed subroutine name and removed
+ unnecessary code.
+ * gfortran.dg/c_ptr_tests_driver.c: Modified to match with
+ c_ptr_tests.f03.
+ * gfortran.dg/dg.exp: Modified to accept .f03/.F03 files.
+
2006-12-20 Roger Sayle <roger@eyesopen.com>
* gfortran.dg/array_memset_1.f90: New test case.
Index: gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c (revision 120681)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c (working copy)
@@ -1,3 +1,5 @@
+/* this is the driver for c_ptr_test.f03 */
+
typedef struct services
{
int compId;
@@ -11,36 +13,22 @@ typedef struct comp
void *myPort;
}comp_t;
-
/* prototypes for f90 functions */
-extern void ptr_test(comp_t *self, services_t *myServices, double
myDouble);
-
-/* c function prototypes */
-void test(double myDouble);
+void sub0(comp_t *self, services_t *myServices);
int main(int argc, char **argv)
{
services_t servicesObj;
comp_t myComp;
- double myDouble;
servicesObj.compId = 17;
-/* servicesObj.globalServices = NULL; */
- /* nullify the ptr */
- servicesObj.globalServices = 0;
+ servicesObj.globalServices = 0; /* NULL; */
myComp.myServices = &servicesObj;
-/* myComp.setServices = NULL; */
- myComp.setServices = 0;
-/* myComp.myPort = NULL; */
- myComp.myPort = 0;
- myDouble = 1.23456;
+ myComp.setServices = 0; /* NULL; */
+ myComp.myPort = 0; /* NULL; */
- ptr_test(&myComp, &servicesObj, myDouble);
+ sub0(&myComp, &servicesObj);
return 0;
}/* end main() */
-void test(double myDouble)
-{
- return;
-}/* end test() */
Index: gcc/testsuite/gfortran.dg/c_ptr_tests.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests.f90 (revision 120681)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests.f90 (working copy)
@@ -1,53 +0,0 @@
-! { dg-do run }
-! { dg-additional-sources c_ptr_tests_driver.c }
-module c_ptrTests
- use, intrinsic :: iso_c_binding
-
- ! TODO::
- ! in order to be associated with a C address,
- ! the derived type needs to be C interoperable,
- ! which requires bind(c) and all fields interoperable
- ! currently, the compiler doesn't verify that the 2nd arg
- ! to c_f_pointer is C interoperable.. --Rickett, 03.01.06
- type, bind(c) :: myType
- type(c_ptr) :: myServices
- type(c_funptr) :: mySetServices
- type(c_ptr) :: myPort
- end type myType
-
- type, bind(c) :: f90Services
- integer(c_int) :: compId
- type(c_ptr) :: globalServices
- end type f90Services
-
- interface
- subroutine test(myDouble) bind(c)
- use, intrinsic :: iso_c_binding, only: c_double, c_ptr
- real(c_double), value :: myDouble
- end subroutine test
- end interface
-
- contains
-
- subroutine ptr_test(c_self, services, myDouble) bind(c)
- use, intrinsic :: iso_c_binding
- implicit none
-
- type(c_ptr), value :: c_self, services
- real(c_double), value :: myDouble
- type(myType), pointer :: self
- type(f90Services), pointer :: localServices
-
- call c_f_pointer(c_self, self)
- if(.not. associated(self)) then
- call abort()
- end if
- self%myServices = services
-
- ! this is a C routine
- call test(myDouble)
-
- ! get access to the local services obj from C
- call c_f_pointer(self%myServices, localServices)
- end subroutine ptr_test
-end module c_ptrTests
Index: gcc/testsuite/gfortran.dg/dg.exp
===================================================================
--- gcc/testsuite/gfortran.dg/dg.exp (revision 120681)
+++ gcc/testsuite/gfortran.dg/dg.exp (working copy)
@@ -30,7 +30,7 @@ dg-init
# Main loop.
gfortran-dg-runtest [lsort \
- [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95} ] ]
$DEFAULT_FFLAGS
+ [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03} ] ]
$DEFAULT_FFLAGS
gfortran-dg-runtest [lsort \
[glob -nocomplain $srcdir/$subdir/g77/*.\[fF\] ] ] $DEFAULT_FFLAGS
Index: gcc/testsuite/gfortran.dg/c_ptr_tests.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests.f03 (revision 0)
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-additional-sources c_ptr_tests_driver.c }
+module c_ptr_tests
+ use, intrinsic :: iso_c_binding
+
+ ! TODO::
+ ! in order to be associated with a C address,
+ ! the derived type needs to be C interoperable,
+ ! which requires bind(c) and all fields interoperable.
+ type, bind(c) :: myType
+ type(c_ptr) :: myServices
+ type(c_funptr) :: mySetServices
+ type(c_ptr) :: myPort
+ end type myType
+
+ type, bind(c) :: f90Services
+ integer(c_int) :: compId
+ type(c_ptr) :: globalServices
+ end type f90Services
+
+ contains
+
+ subroutine sub0(c_self, services) bind(c)
+ use, intrinsic :: iso_c_binding
+ implicit none
+ type(c_ptr), value :: c_self, services
+ type(myType), pointer :: self
+ type(f90Services), pointer :: localServices
+ type(c_ptr) :: my_cptr
+
+ call c_f_pointer(c_self, self)
+ if(.not. associated(self)) then
+ print *, 'self is not associated'
+ end if
+ self%myServices = services
+
+ ! c_null_ptr is defined in iso_c_binding
+ my_cptr = c_null_ptr
+
+ ! get access to the local services obj from C
+ call c_f_pointer(self%myServices, localServices)
+ end subroutine sub0
+end module c_ptr_tests