gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90

   1 ! Test various intrinsics who take a kind argument since Fortran 2003
   2 !
   3 ! { dg-do compile }
   4 !
   5 program test
   6   integer, parameter :: k = kind(0)
   7   logical :: l_array(4,5)
   8   character(len=1) :: s
   9   character(len=20) :: t
  10
  11   l_array = .true.
  12   s = "u"
  13   t = "bartutugee"
  14
  15   call check (count(l_array, kind=k), 20)
  16   if (any (count(l_array, 2, kind=k) /= 5)) call abort
  17   if (any (count(l_array, kind=k, dim=2) /= 5)) call abort
  18
  19   call check (iachar (s, k), 117)
  20   call check (iachar (s, kind=k), 117)
  21   call check (ichar (s, k), 117)
  22   call check (ichar (s, kind=k), 117)
  23
  24   if (achar(107) /= achar(107,1)) call abort
  25
  26   call check (index (t, s, .true., k), 7)
  27   call check (index (t, s, kind=k, back=.false.), 5)
  28
  29   if (any (lbound (l_array, kind=k) /= 1)) call abort
  30   call check (lbound (l_array, 1), 1)
  31   call check (lbound (l_array, 1, kind=k), 1)
  32
  33   if (any (ubound (l_array, kind=k) /= (/4, 5/))) call abort
  34   call check (ubound (l_array, 1), 4)
  35   call check (ubound (l_array, 1, kind=k), 4)
  36
  37   call check (len(t, k), 20)
  38   call check (len_trim(t, k), 10)
  39
  40   call check (scan (t, s, .true., k), 7)
  41   call check (scan (t, s, kind=k, back=.false.), 5)
  42
  43   call check (size (l_array, 1, kind=k), 4)
  44   call check (size (l_array, kind=k), 20)
  45
  46   call check (verify (t, s, .true., k), 20)
  47   call check (verify (t, s, kind=k, back=.false.), 1)
  48
  49 contains
  50
  51   subroutine check(x,y)
  52     integer, intent(in) :: x, y
  53     if (x /= y) call abort
  54   end subroutine check
  55
  56 end program test