flang/test/Semantics/case01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test SELECT CASE Constraints: C1145, C1146, C1147, C1148, C1149
   3 program selectCaseProg
   4    implicit none
   5    ! local variable declaration
   6    character :: grade1 = 'B'
   7    integer :: grade2 = 3
   8    logical :: grade3 = .false.
   9    real :: grade4 = 2.0
  10    character (len = 10) :: name = 'test'
  11    logical, parameter :: grade5 = .false.
  12    CHARACTER(KIND=1), parameter :: ASCII_parm1 = 'a', ASCII_parm2='b'
  13    CHARACTER(KIND=2), parameter :: UCS16_parm = 'c'
  14    CHARACTER(KIND=4), parameter :: UCS32_parm ='d'
  15    type scores
  16      integer :: val
  17    end type
  18    type (scores) :: score = scores(25)
  19    type (scores), parameter :: score_val = scores(50)
  20
  21   ! Valid Cases
  22    select case (grade1)
  23       case ('A')
  24       case ('B')
  25       case ('C')
  26       case default
  27    end select
  28
  29    select case (grade2)
  30       case (1)
  31       case (2)
  32       case (3)
  33       case default
  34    end select
  35
  36    select case (grade3)
  37       case (.true.)
  38       case (.false.)
  39    end select
  40
  41    select case (name)
  42       case default
  43       case ('now')
  44       case ('test')
  45    end select
  46
  47   ! C1145
  48   !ERROR: SELECT CASE expression must be integer, logical, or character
  49   select case (grade4)
  50      case (1.0)
  51      case (2.0)
  52      case (3.0)
  53      case default
  54   end select
  55
  56   !ERROR: SELECT CASE expression must be integer, logical, or character
  57   select case (score)
  58      case (score_val)
  59      case (scores(100))
  60   end select
  61
  62   ! C1146
  63   select case (grade3)
  64      case default
  65      case (.true.)
  66      !ERROR: CASE DEFAULT conflicts with previous cases
  67      case default
  68   end select
  69
  70   ! C1147
  71   select case (grade2)
  72      !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
  73      case (:'Z')
  74      case default
  75    end select
  76
  77   select case (grade1)
  78      !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
  79      case (:1)
  80      case default
  81    end select
  82
  83   select case (grade3)
  84      case default
  85      case (.true.)
  86      !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'LOGICAL(4)'
  87      case (3)
  88   end select
  89
  90   select case (grade2)
  91      case default
  92      case (2 :)
  93      !ERROR: CASE value has type 'LOGICAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
  94      case (.true. :)
  95      !ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
  96      case (1.0)
  97      !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=3_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
  98      case ('wow')
  99   end select
 100
 101   select case (ASCII_parm1)
 102      case (ASCII_parm2)
 103      !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
 104      case (UCS32_parm)
 105      !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
 106      case (UCS16_parm)
 107      !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
 108      case (4_"ucs-32")
 109      !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
 110      case (2_"ucs-16")
 111      case default
 112    end select
 113
 114   ! C1148
 115   select case (grade3)
 116      case default
 117      !ERROR: CASE range is not allowed for LOGICAL
 118      case (.true. :)
 119   end select
 120
 121   ! C1149
 122   select case (grade3)
 123     case (.true.)
 124     case (.false.)
 125      !ERROR: CASE (.true._1) conflicts with previous cases
 126      case (.true.)
 127     !ERROR: CASE (.false._1) conflicts with previous cases
 128      case (grade5)
 129   end select
 130
 131   select case (grade2)
 132      !WARNING: CASE has lower bound greater than upper bound
 133      case (51:50)
 134      case (100:)
 135      case (:30)
 136      case (40)
 137      case (90)
 138      case (91:99)
 139      !ERROR: CASE (81_4:90_4) conflicts with previous cases
 140      case (81:90)
 141      !ERROR: CASE (:80_4) conflicts with previous cases
 142      case (:80)
 143      !ERROR: CASE (200_4) conflicts with previous cases
 144      case (200)
 145      case default
 146   end select
 147
 148   select case (name)
 149      case ('hello')
 150      case ('hey')
 151      !ERROR: CASE (:"hh") conflicts with previous cases
 152      case (:'hh')
 153      !ERROR: CASE (:"hd") conflicts with previous cases
 154      case (:'hd')
 155      case ( 'hu':)
 156      case ('hi':'ho')
 157      !ERROR: CASE ("hj") conflicts with previous cases
 158      case ('hj')
 159      !ERROR: CASE ("ha") conflicts with previous cases
 160      case ('ha')
 161      !ERROR: CASE ("hz") conflicts with previous cases
 162      case ('hz')
 163      case default
 164    end select
 165
 166 end program
 167
 168 subroutine test_overlap
 169   integer :: i
 170   !OK: these cases do not overlap
 171   select case(i)
 172     case(0:)
 173     case(:-1)
 174   end select
 175   select case(i)
 176     case(-1:)
 177     !ERROR: CASE (:0_4) conflicts with previous cases
 178     case(:0)
 179   end select
 180 end
 181
 182 subroutine test_overflow
 183   integer :: j
 184   select case(1_1)
 185   case (127)
 186   !WARNING: CASE value (128_4) overflows type (INTEGER(1)) of SELECT CASE expression
 187   case (128)
 188   !WARNING: CASE value (129_4) overflows type (INTEGER(1)) of SELECT CASE expression
 189   !WARNING: CASE value (130_4) overflows type (INTEGER(1)) of SELECT CASE expression
 190   case (129:130)
 191   !WARNING: CASE value (-130_4) overflows type (INTEGER(1)) of SELECT CASE expression
 192   !WARNING: CASE value (-129_4) overflows type (INTEGER(1)) of SELECT CASE expression
 193   case (-130:-129)
 194   case (-128)
 195   !ERROR: Must be a scalar value, but is a rank-1 array
 196   case ([1, 2])
 197   !ERROR: Must be a constant value
 198   case (j)
 199   case default
 200   end select
 201 end