gcc/testsuite/gfortran.dg/select_char_1.f90

   1 ! { dg-do run }
   2 integer function char_select (s)
   3   character(len=*), intent(in) :: s
   4
   5   select case(s)
   6     case ("foo")
   7       char_select = 1
   8     case ("bar", "gee")
   9       char_select = 2
  10     case ("111", "999")
  11       char_select = 3
  12     case ("1024", "1900")
  13       char_select = 4
  14     case ("12", "17890")
  15       char_select = 5
  16     case default
  17       char_select = -1
  18   end select
  19 end function char_select
  20
  21 integer function char_select2 (s)
  22   character(len=*), intent(in) :: s
  23
  24   char_select2 = -1
  25   select case(s)
  26     case ("foo")
  27       char_select2 = 1
  28     case ("bar", "gee")
  29       char_select2 = 2
  30     case ("111", "999")
  31       char_select2 = 3
  32     case ("1024", "1900")
  33       char_select2 = 4
  34     case ("12", "17890")
  35       char_select2 = 5
  36   end select
  37 end function char_select2
  38
  39
  40 program test
  41   interface
  42     integer function char_select (s)
  43       character(len=*), intent(in) :: s
  44     end function char_select
  45     integer function char_select2 (s)
  46       character(len=*), intent(in) :: s
  47     end function char_select2
  48   end interface
  49
  50   if (char_select("foo") /= 1) call abort
  51   if (char_select("foo ") /= 1) call abort
  52   if (char_select("foo2 ") /= -1) call abort
  53   if (char_select("bar") /= 2) call abort
  54   if (char_select("gee") /= 2) call abort
  55   if (char_select("000") /= -1) call abort
  56   if (char_select("101") /= -1) call abort
  57   if (char_select("109") /= -1) call abort
  58   if (char_select("111") /= 3) call abort
  59   if (char_select("254") /= -1) call abort
  60   if (char_select("999") /= 3) call abort
  61   if (char_select("9989") /= -1) call abort
  62   if (char_select("1882") /= -1) call abort
  63
  64   if (char_select2("foo") /= 1) call abort
  65   if (char_select2("foo ") /= 1) call abort
  66   if (char_select2("foo2 ") /= -1) call abort
  67   if (char_select2("bar") /= 2) call abort
  68   if (char_select2("gee") /= 2) call abort
  69   if (char_select2("000") /= -1) call abort
  70   if (char_select2("101") /= -1) call abort
  71   if (char_select2("109") /= -1) call abort
  72   if (char_select2("111") /= 3) call abort
  73   if (char_select2("254") /= -1) call abort
  74   if (char_select2("999") /= 3) call abort
  75   if (char_select2("9989") /= -1) call abort
  76   if (char_select2("1882") /= -1) call abort
  77 end program test