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

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