gcc/testsuite/gfortran.dg/assumed_type_13.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources assumed_type_13.c }
   3
   4 use iso_c_binding, only: c_size_t, c_int
   5 implicit none (type, external)
   6
   7 interface
   8   subroutine test_c (x, n, num) bind (C)
   9     import :: c_size_t, c_int
  10     integer(c_size_t), value :: n
  11     integer(c_int), value :: num
  12     type(*) :: x(:)
  13   end subroutine test_c
  14 end interface
  15
  16 complex(8) :: b(3)
  17
  18 call test_c ([1_2, 2_2, 3_2], sizeof(1_2), num=1)
  19 call test_c (b, sizeof(b(1)), num=2)
  20 call outer_bc ([1_2, 2_2, 3_2], sizeof(1_2), num=1)
  21 call outer_bc (b, sizeof(b(1)), num=2)
  22 call outer_f ([1_2, 2_2, 3_2], sizeof(1_2), num=1)
  23 call outer_f (b, sizeof(b(1)), num=2)
  24
  25 contains
  26
  27 subroutine outer_bc (x, n, num) bind(C)
  28   integer(c_size_t), value :: n
  29   integer(c_int), value :: num
  30   type(*) :: x(:)
  31   !  print *,sizeof(x)/size(x), n
  32   if (sizeof(x)/size(x) /=  n) error stop 1
  33   call inner_bc (x, n, num)
  34   call inner_f (x, n, num)
  35   call test_c (x, n, num)
  36 end
  37
  38 subroutine outer_f (x, n, num)
  39   integer(c_size_t), value :: n
  40   integer(c_int), value :: num
  41   type(*) :: x(:)
  42   !  print *,sizeof(x)/size(x), n
  43   if (sizeof(x)/size(x) /=  n) error stop 1
  44   call inner_f (x, n, num)
  45   call inner_bc (x, n, num)
  46   call test_c (x, n, num)
  47 end
  48
  49 subroutine inner_bc(x, n, num) bind(C)
  50   integer(c_size_t), value :: n
  51   integer(c_int), value :: num
  52   type(*) :: x(:)
  53   !  print *,sizeof(x)/size(x), n
  54   if (sizeof(x)/size(x) /=  n) error stop 2
  55   call test_c (x, n, num)
  56 end
  57
  58 subroutine inner_f(x, n, num)
  59   integer(c_size_t), value :: n
  60   integer(c_int), value :: num
  61   type(*) :: x(:)
  62   !  print *,sizeof(x)/size(x), n
  63   if (sizeof(x)/size(x) /=  n) error stop 3
  64   call test_c (x, n, num)
  65 end
  66 end