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(1)' 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(1)' 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(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
 104      case (UCS32_parm)
 105      !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
 106      case (UCS16_parm)
 107      !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
 108      case (4_"ucs-32")
 109      !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
 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      case (51:50) ! warning
 133      case (100:)
 134      case (:30)
 135      case (40)
 136      case (90)
 137      case (91:99)
 138      !ERROR: CASE (81_4:90_4) conflicts with previous cases
 139      case (81:90)
 140      !ERROR: CASE (:80_4) conflicts with previous cases
 141      case (:80)
 142      !ERROR: CASE (200_4) conflicts with previous cases
 143      case (200)
 144      case default
 145   end select
 146
 147   select case (name)
 148      case ('hello')
 149      case ('hey')
 150      !ERROR: CASE (:"hh") conflicts with previous cases
 151      case (:'hh')
 152      !ERROR: CASE (:"hd") conflicts with previous cases
 153      case (:'hd')
 154      case ( 'hu':)
 155      case ('hi':'ho')
 156      !ERROR: CASE ("hj") conflicts with previous cases
 157      case ('hj')
 158      !ERROR: CASE ("ha") conflicts with previous cases
 159      case ('ha')
 160      !ERROR: CASE ("hz") conflicts with previous cases
 161      case ('hz')
 162      case default
 163    end select
 164
 165 end program
 166
 167 program test_overlap
 168   integer :: i
 169   !OK: these cases do not overlap
 170   select case(i)
 171     case(0:)
 172     case(:-1)
 173   end select
 174   select case(i)
 175     case(-1:)
 176     !ERROR: CASE (:0_4) conflicts with previous cases
 177     case(:0)
 178   end select
 179 end