gcc/testsuite/gfortran.dg/bind_c_usage_14.f03

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/34079
   5 ! Bind(C) procedures shall have no character length
   6 ! dummy and actual arguments.
   7 !
   8
   9 ! SUBROUTINES
  10
  11 subroutine sub1noiso(a, b)
  12   use iso_c_binding
  13   implicit none
  14   character(len=1,kind=c_char) :: a(*), b
  15   character(len=1,kind=c_char):: x,z
  16   integer(c_int) :: y
  17   value :: b
  18   print *, a(1:2), b
  19 end subroutine sub1noiso
  20
  21 subroutine sub2(a, b) bind(c)
  22   use iso_c_binding
  23   implicit none
  24   character(len=1,kind=c_char) :: a(*), b
  25   character(len=1,kind=c_char):: x,z
  26   integer(c_int) :: y
  27   value :: b
  28   print *, a(1:2), b
  29 end subroutine sub2
  30
  31 ! SUBROUTINES with ENTRY
  32
  33 subroutine sub3noiso(a, b)
  34   use iso_c_binding
  35   implicit none
  36   character(len=1,kind=c_char) :: a(*), b
  37   character(len=1,kind=c_char):: x,z
  38   integer(c_int) :: y
  39   value :: b
  40   print *, a(1:2), b
  41 entry sub3noisoEntry(x,y,z)
  42   x = 'd'
  43 end subroutine sub3noiso
  44
  45 subroutine sub4iso(a, b) bind(c)
  46   use iso_c_binding
  47   implicit none
  48   character(len=1,kind=c_char) :: a(*), b
  49   character(len=1,kind=c_char):: x,z
  50   integer(c_int) :: y
  51   value :: b
  52   print *, a(1:2), b
  53 entry sub4isoEntry(x,y,z)
  54   x = 'd'
  55 end subroutine sub4iso
  56
  57 subroutine sub5iso(a, b) bind(c)
  58   use iso_c_binding
  59   implicit none
  60   character(len=1,kind=c_char) :: a(*), b
  61   character(len=1,kind=c_char):: x,z
  62   integer(c_int) :: y
  63   value :: b
  64   print *, a(1:2), b
  65 entry sub5noIsoEntry(x,y,z)
  66   x = 'd'
  67 end subroutine sub5iso
  68
  69 subroutine sub6NoIso(a, b)
  70   use iso_c_binding
  71   implicit none
  72   character(len=1,kind=c_char) :: a(*), b
  73   character(len=1,kind=c_char):: x,z
  74   integer(c_int) :: y
  75   value :: b
  76   print *, a(1:2), b
  77 entry sub6isoEntry(x,y,z)
  78   x = 'd'
  79 end subroutine sub6NoIso
  80
  81 ! The subroutines (including entry) should have
  82 ! only a char-length parameter if they are not bind(C).
  83 !
  84 ! { dg-final { scan-tree-dump "sub1noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
  85 ! { dg-final { scan-tree-dump "sub2 \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
  86 ! { dg-final { scan-tree-dump "sub3noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
  87 ! { dg-final { scan-tree-dump "sub3noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
  88 ! { dg-final { scan-tree-dump "sub4iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
  89 ! { dg-final { scan-tree-dump "sub4isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
  90 ! { dg-final { scan-tree-dump "sub5iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
  91 ! { dg-final { scan-tree-dump "sub5noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
  92 ! { dg-final { scan-tree-dump "sub6noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
  93 ! { dg-final { scan-tree-dump "sub6isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
  94
  95 ! The master functions should have always a length parameter
  96 ! to ensure sharing a parameter between bind(C) and non-bind(C) works
  97 !
  98 ! { dg-final { scan-tree-dump "master.0.sub3noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
  99 ! { dg-final { scan-tree-dump "master.1.sub4iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
 100 ! { dg-final { scan-tree-dump "master.2.sub5iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
 101 ! { dg-final { scan-tree-dump "master.3.sub6noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
 102
 103 ! Thus, the master functions need to be called with length arguments
 104 ! present
 105 !
 106 ! { dg-final { scan-tree-dump "master.0.sub3noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
 107 ! { dg-final { scan-tree-dump "master.0.sub3noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
 108 ! { dg-final { scan-tree-dump "master.1.sub4iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
 109 ! { dg-final { scan-tree-dump "master.1.sub4iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
 110 ! { dg-final { scan-tree-dump "master.2.sub5iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
 111 ! { dg-final { scan-tree-dump "master.2.sub5iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
 112 ! { dg-final { scan-tree-dump "master.3.sub6noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
 113 ! { dg-final { scan-tree-dump "master.3.sub6noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
 114
 115 ! { dg-final { cleanup-tree-dump "original" } }