From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 | 61 +++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 (limited to 'gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03') diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 new file mode 100644 index 000000000..fd9703139 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 @@ -0,0 +1,61 @@ +! { dg-do run } +! { dg-additional-sources c_f_pointer_complex_driver.c } +! { dg-options "-std=gnu -w" } +! Test c_f_pointer for the different types of interoperable complex values. +module c_f_pointer_complex + use, intrinsic :: iso_c_binding, only: c_float_complex, c_double_complex, & + c_long_double_complex, c_f_pointer, c_ptr, c_long_double, c_int + implicit none + +contains + subroutine test_complex_scalars(my_c_float_complex, my_c_double_complex, & + my_c_long_double_complex) bind(c) + type(c_ptr), value :: my_c_float_complex + type(c_ptr), value :: my_c_double_complex + type(c_ptr), value :: my_c_long_double_complex + complex(c_float_complex), pointer :: my_f03_float_complex + complex(c_double_complex), pointer :: my_f03_double_complex + complex(c_long_double_complex), pointer :: my_f03_long_double_complex + + call c_f_pointer(my_c_float_complex, my_f03_float_complex) + call c_f_pointer(my_c_double_complex, my_f03_double_complex) + call c_f_pointer(my_c_long_double_complex, my_f03_long_double_complex) + + if(my_f03_float_complex /= (1.0, 0.0)) call abort () + if(my_f03_double_complex /= (2.0d0, 0.0d0)) call abort () + if(my_f03_long_double_complex /= (3.0_c_long_double, & + 0.0_c_long_double)) call abort () + end subroutine test_complex_scalars + + subroutine test_complex_arrays(float_complex_array, double_complex_array, & + long_double_complex_array, num_elems) bind(c) + type(c_ptr), value :: float_complex_array + type(c_ptr), value :: double_complex_array + type(c_ptr), value :: long_double_complex_array + complex(c_float_complex), pointer, dimension(:) :: f03_float_complex_array + complex(c_double_complex), pointer, dimension(:) :: & + f03_double_complex_array + complex(c_long_double_complex), pointer, dimension(:) :: & + f03_long_double_complex_array + integer(c_int), value :: num_elems + integer :: i + + call c_f_pointer(float_complex_array, f03_float_complex_array, & + (/ num_elems /)) + call c_f_pointer(double_complex_array, f03_double_complex_array, & + (/ num_elems /)) + call c_f_pointer(long_double_complex_array, & + f03_long_double_complex_array, (/ num_elems /)) + + do i = 1, num_elems + if(f03_float_complex_array(i) & + /= (i*(1.0, 0.0))) call abort () + if(f03_double_complex_array(i) & + /= (i*(1.0d0, 0.0d0))) call abort () + if(f03_long_double_complex_array(i) & + /= (i*(1.0_c_long_double, 0.0_c_long_double))) call abort () + end do + end subroutine test_complex_arrays +end module c_f_pointer_complex +! { dg-final { cleanup-modules "c_f_pointer_complex" } } + -- cgit v1.2.3