gcc/testsuite/gfortran.dg/selected_char_kind_1.f90

   1 ! { dg-do run }
   2 !
   3 ! Checks for the SELECTED_CHAR_KIND intrinsic
   4 !
   5   integer, parameter :: ascii = selected_char_kind ("ascii")
   6   integer, parameter :: default = selected_char_kind ("default")
   7
   8   character(kind=ascii) :: s1
   9   character(kind=default) :: s2
  10   character(kind=selected_char_kind ("ascii")) :: s3
  11   character(kind=selected_char_kind ("default")) :: s4
  12
  13   if (kind (s1) /= selected_char_kind ("ascii")) call abort
  14   if (kind (s2) /= selected_char_kind ("default")) call abort
  15   if (kind (s3) /= ascii) call abort
  16   if (kind (s4) /= default) call abort
  17
  18   if (selected_char_kind("ascii") /= 1) call abort
  19   if (selected_char_kind("default") /= 1) call abort
  20   if (selected_char_kind("defauLt") /= 1) call abort
  21   if (selected_char_kind("foo") /= -1) call abort
  22   if (selected_char_kind("asciiiii") /= -1) call abort
  23   if (selected_char_kind("default       ") /= 1) call abort
  24
  25   call test("ascii", 1)
  26   call test("default", 1)
  27   call test("defauLt", 1)
  28   call test("asciiiiii", -1)
  29   call test("foo", -1)
  30   call test("default     ", 1)
  31   call test("default     x", -1)
  32
  33   call test(ascii_"ascii", 1)
  34   call test(ascii_"default", 1)
  35   call test(ascii_"defauLt", 1)
  36   call test(ascii_"asciiiiii", -1)
  37   call test(ascii_"foo", -1)
  38   call test(ascii_"default     ", 1)
  39   call test(ascii_"default     x", -1)
  40
  41   call test(default_"ascii", 1)
  42   call test(default_"default", 1)
  43   call test(default_"defauLt", 1)
  44   call test(default_"asciiiiii", -1)
  45   call test(default_"foo", -1)
  46   call test(default_"default     ", 1)
  47   call test(default_"default     x", -1)
  48
  49   if (kind (selected_char_kind ("")) /= kind(0)) call abort
  50 end
  51
  52 subroutine test(s,i)
  53   character(len=*,kind=selected_char_kind("ascii")) s
  54   integer i
  55
  56   call test2(s,i)
  57   if (selected_char_kind (s) /= i) call abort
  58 end subroutine test
  59
  60 subroutine test2(s,i)
  61   character(len=*,kind=selected_char_kind("default")) s
  62   integer i
  63
  64   if (selected_char_kind (s) /= i) call abort
  65 end subroutine test2