libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90

   1 ! FIRSTPRIVATE: CLASS(*) + intrinsic types
   2 program select_type_openmp
   3   implicit none
   4   class(*), allocatable :: val1, val1a, val2, val3
   5
   6   call sub() ! local var
   7
   8   call sub2(val1, val1a, val2, val3) ! allocatable args
   9
  10   allocate(val1, source=7)
  11   allocate(val1a, source=7)
  12   allocate(val2, source="abcdef")
  13   allocate(val3, source=4_"zyx4")
  14   call sub3(val1, val1a, val2, val3)  ! nonallocatable vars
  15   deallocate(val1, val1a, val2, val3)
  16 contains
  17 subroutine sub()
  18   class(*), allocatable :: val1, val1a, val2, val3
  19   allocate(val1a, source=7)
  20   allocate(val2, source="abcdef")
  21   allocate(val3, source=4_"zyx4")
  22
  23   if (allocated(val1)) stop 1
  24
  25   !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
  26     if (allocated(val1)) stop 2
  27     if (.not.allocated(val1a)) stop 3
  28     if (.not.allocated(val2)) stop 4
  29     if (.not.allocated(val3)) stop 5
  30
  31     allocate(val1, source=7)
  32
  33     select type (val1)
  34       type is (integer)
  35         if (val1 /= 7) stop 6
  36         val1 = 8
  37       class default
  38         stop 7
  39     end select
  40
  41     select type (val1a)
  42       type is (integer)
  43         if (val1a /= 7) stop 8
  44         val1a = 8
  45       class default
  46         stop 9
  47     end select
  48
  49     select type (val2)
  50       type is (character(len=*))
  51         if (len(val2) /= 6) stop 10
  52         if (val2 /= "abcdef") stop 11
  53         val2 = "123456"
  54       class default
  55         stop 12
  56     end select
  57
  58     select type (val3)
  59       type is (character(len=*, kind=4))
  60         if (len(val3) /= 4) stop 13
  61         if (val3 /= 4_"zyx4") stop 14
  62         val3 = 4_"AbCd"
  63       class default
  64         stop 15
  65     end select
  66
  67     select type (val3)
  68       type is (character(len=*, kind=4))
  69         if (len(val3) /= 4) stop 16
  70         if (val3 /= 4_"AbCd") stop 17
  71         val3 = 4_"1ab2"
  72       class default
  73         stop 18
  74     end select
  75
  76     select type (val2)
  77       type is (character(len=*))
  78         if (len(val2) /= 6) stop 19
  79         if (val2 /= "123456") stop 20
  80         val2 = "A2C4E6"
  81       class default
  82         stop 21
  83     end select
  84
  85     select type (val1)
  86       type is (integer)
  87         if (val1 /= 8) stop 22
  88         val1 = 9
  89       class default
  90         stop 23
  91     end select
  92
  93     select type (val1a)
  94       type is (integer)
  95         if (val1a /= 8) stop 24
  96         val1a = 9
  97       class default
  98         stop 25
  99     end select
 100   !$OMP END PARALLEL
 101
 102   if (allocated(val1)) stop 26
 103   if (.not. allocated(val1a)) stop 27
 104   if (.not. allocated(val2)) stop 28
 105
 106   select type (val2)
 107     type is (character(len=*))
 108       if (len(val2) /= 6) stop 29
 109       if (val2 /= "abcdef") stop 30
 110     class default
 111       stop 31
 112   end select
 113   select type (val3)
 114     type is (character(len=*,kind=4))
 115       if (len(val3) /= 4) stop 32
 116       if (val3 /= 4_"zyx4") stop 33
 117     class default
 118       stop 34
 119   end select
 120   deallocate(val1a, val2, val3)
 121 end subroutine sub
 122
 123 subroutine sub2(val1, val1a, val2, val3)
 124   class(*), allocatable :: val1, val1a, val2, val3
 125   optional :: val1a
 126   allocate(val1a, source=7)
 127   allocate(val2, source="abcdef")
 128   allocate(val3, source=4_"zyx4")
 129
 130   if (allocated(val1)) stop 35
 131
 132   !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
 133     if (allocated(val1)) stop 36
 134     if (.not.allocated(val1a)) stop 37
 135     if (.not.allocated(val2)) stop 38
 136     if (.not.allocated(val3)) stop 39
 137
 138     allocate(val1, source=7)
 139
 140     select type (val1)
 141       type is (integer)
 142         if (val1 /= 7) stop 40
 143         val1 = 8
 144       class default
 145         stop 41
 146     end select
 147
 148     select type (val1a)
 149       type is (integer)
 150         if (val1a /= 7) stop 42
 151         val1a = 8
 152       class default
 153         stop 43
 154     end select
 155
 156     select type (val2)
 157       type is (character(len=*))
 158         if (len(val2) /= 6) stop 44
 159         if (val2 /= "abcdef") stop 45
 160         val2 = "123456"
 161       class default
 162         stop 46
 163     end select
 164
 165     select type (val3)
 166       type is (character(len=*, kind=4))
 167         if (len(val3) /= 4) stop 47
 168         if (val3 /= 4_"zyx4") stop 48
 169         val3 = "AbCd"
 170       class default
 171         stop 49
 172     end select
 173
 174     select type (val3)
 175       type is (character(len=*, kind=4))
 176         if (len(val3) /= 4) stop 50
 177         if (val3 /= 4_"AbCd") stop 51
 178         val3 = 4_"1ab2"
 179       class default
 180         stop 52
 181     end select
 182
 183     select type (val2)
 184       type is (character(len=*))
 185         if (len(val2) /= 6) stop 53
 186         if (val2 /= "123456") stop 54
 187         val2 = "A2C4E6"
 188       class default
 189         stop 55
 190     end select
 191
 192     select type (val1)
 193       type is (integer)
 194         if (val1 /= 8) stop 56
 195         val1 = 9
 196       class default
 197         stop 57
 198     end select
 199
 200     select type (val1a)
 201       type is (integer)
 202         if (val1a /= 8) stop 58
 203         val1a = 9
 204       class default
 205         stop 59
 206     end select
 207   !$OMP END PARALLEL
 208
 209   if (allocated(val1)) stop 60
 210   if (.not. allocated(val1a)) stop 61
 211   if (.not. allocated(val2)) stop 62
 212
 213   select type (val2)
 214     type is (character(len=*))
 215       if (len(val2) /= 6) stop 63
 216       if (val2 /= "abcdef") stop 64
 217     class default
 218         stop 65
 219   end select
 220
 221   select type (val3)
 222     type is (character(len=*, kind=4))
 223       if (len(val3) /= 4) stop 66
 224       if (val3 /= 4_"zyx4") stop 67
 225       val3 = 4_"AbCd"
 226     class default
 227       stop 68
 228   end select
 229   deallocate(val1a, val2, val3)
 230 end subroutine sub2
 231
 232 subroutine sub3(val1, val1a, val2, val3)
 233   class(*) :: val1, val1a, val2, val3
 234   optional :: val1a
 235
 236   !$OMP PARALLEL firstprivate(val1, val1a, val2, val3)
 237     select type (val1)
 238       type is (integer)
 239         if (val1 /= 7) stop 69
 240         val1 = 8
 241       class default
 242         stop 70
 243     end select
 244
 245     select type (val1a)
 246       type is (integer)
 247         if (val1a /= 7) stop 71
 248         val1a = 8
 249       class default
 250         stop 72
 251     end select
 252
 253     select type (val2)
 254       type is (character(len=*))
 255         if (len(val2) /= 6) stop 73
 256         if (val2 /= "abcdef") stop 74
 257         val2 = "123456"
 258       class default
 259         stop 75
 260     end select
 261
 262     select type (val3)
 263       type is (character(len=*, kind=4))
 264         if (len(val3) /= 4) stop 76
 265         if (val3 /= 4_"zyx4") stop 77
 266         val3 = 4_"AbCd"
 267       class default
 268         stop 78
 269     end select
 270
 271     select type (val3)
 272       type is (character(len=*, kind=4))
 273         if (len(val3) /= 4) stop 79
 274         if (val3 /= 4_"AbCd") stop 80
 275         val3 = 4_"1ab2"
 276       class default
 277         stop 81
 278     end select
 279
 280     select type (val2)
 281       type is (character(len=*))
 282         if (len(val2) /= 6) stop 82
 283         if (val2 /= "123456") stop 83
 284         val2 = "A2C4E6"
 285       class default
 286         stop 84
 287     end select
 288
 289     select type (val1)
 290       type is (integer)
 291         if (val1 /= 8) stop 85
 292         val1 = 9
 293       class default
 294         stop 86
 295     end select
 296
 297     select type (val1a)
 298       type is (integer)
 299         if (val1a /= 8) stop 87
 300         val1a = 9
 301       class default
 302         stop 88
 303     end select
 304   !$OMP END PARALLEL
 305
 306   select type (val2)
 307     type is (character(len=*))
 308       if (len(val2) /= 6) stop 89
 309       if (val2 /= "abcdef") stop 90
 310     class default
 311       stop 91
 312   end select
 313
 314   select type (val3)
 315     type is (character(len=*, kind=4))
 316       if (len(val3) /= 4) stop 92
 317       if (val3 /= 4_"zyx4") stop 93
 318       val3 = 4_"AbCd"
 319     class default
 320       stop 94
 321   end select
 322 end subroutine sub3
 323 end program select_type_openmp