obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

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.

1 files changed, 88 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
new file mode 100644
index 000000000..4bdf395d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
@@ -0,0 +1,88 @@
+! { dg-do run }
+! { dg-additional-sources c_loc_tests_2_funcs.c }
+module c_loc_tests_2
+use, intrinsic :: iso_c_binding
+implicit none
+
+interface 
+   function test_scalar_address(cptr) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int) :: test_scalar_address
+   end function test_scalar_address
+
+   function test_array_address(cptr, num_elements) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int), value :: num_elements
+     integer(c_int) :: test_array_address
+   end function test_array_address
+
+   function test_type_address(cptr) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int) :: test_type_address
+   end function test_type_address
+end interface
+
+contains
+  subroutine test0() bind(c)
+    integer, target :: xtar
+    integer, pointer :: xptr
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    xtar = 100
+    xptr => xtar
+    my_c_ptr_1 = c_loc(xtar)
+    my_c_ptr_2 = c_loc(xptr)
+    if(test_scalar_address(my_c_ptr_1) .ne. 1) then
+       call abort()
+    end if
+    if(test_scalar_address(my_c_ptr_2) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test0
+
+  subroutine test1() bind(c)
+    integer, target, dimension(100) :: int_array_tar
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    
+    int_array_tar = 100
+    my_c_ptr_1 = c_loc(int_array_tar)
+    if(test_array_address(my_c_ptr_1, 100) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test1
+
+  subroutine test2() bind(c)
+    type, bind(c) :: f90type
+       integer(c_int) :: i
+       real(c_double) :: x
+    end type f90type
+    type(f90type), target :: type_tar
+    type(f90type), pointer :: type_ptr
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    
+    type_ptr => type_tar
+    type_tar%i = 100
+    type_tar%x = 1.0d0
+    my_c_ptr_1 = c_loc(type_tar)
+    my_c_ptr_2 = c_loc(type_ptr)
+    if(test_type_address(my_c_ptr_1) .ne. 1) then
+       call abort()
+    end if
+    if(test_type_address(my_c_ptr_2) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test2
+end module c_loc_tests_2
+
+program driver
+  use c_loc_tests_2
+  call test0()
+  call test1()
+  call test2()
+end program driver
+! { dg-final { cleanup-modules "c_loc_tests_2" } }