gcc/testsuite/gfortran.dg/character_workout_4.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests fix for PR100120/100816/100818/100819/100821
   4 !
   5
   6 program main_p
   7
   8   implicit none
   9
  10   integer, parameter :: k = 4
  11   integer, parameter :: n = 11
  12   integer, parameter :: m = 7
  13   integer, parameter :: l = 3
  14   integer, parameter :: u = 5
  15   integer, parameter :: e = u-l+1
  16   integer, parameter :: c = int(z"FF00")
  17
  18   character(kind=k),         target :: c1(n)
  19   character(len=m, kind=k),  target :: cm(n)
  20   !
  21   character(kind=k),        pointer :: s1
  22   character(len=m, kind=k), pointer :: sm
  23   character(len=e, kind=k), pointer :: se
  24   character(len=:, kind=k), pointer :: sd
  25   !
  26   character(kind=k),        pointer :: p1(:)
  27   character(len=m, kind=k), pointer :: pm(:)
  28   character(len=e, kind=k), pointer :: pe(:)
  29   character(len=:, kind=k), pointer :: pd(:)
  30
  31   class(*),                 pointer :: su
  32   class(*),                 pointer :: pu(:)
  33
  34   integer :: i, j
  35
  36   nullify(s1, sm, se, sd, su)
  37   nullify(p1, pm, pe, pd, pu)
  38   c1 = [(char(i+c, kind=k), i=1,n)]
  39   do i = 1, n
  40     do j = 1, m
  41       cm(i)(j:j) = char(i*m+j+c-m, kind=k)
  42     end do
  43   end do
  44
  45   s1 => c1(n)
  46   if(.not.associated(s1))              stop 1
  47   if(.not.associated(s1, c1(n)))       stop 2
  48   if(len(s1)/=1)                       stop 3
  49   if(s1/=c1(n))                        stop 4
  50   call schar_c1(s1)
  51   call schar_a1(s1)
  52   p1 => c1
  53   if(.not.associated(p1))              stop 5
  54   if(.not.associated(p1, c1))          stop 6
  55   if(len(p1)/=1)                       stop 7
  56   if(any(p1/=c1))                      stop 8
  57   call achar_c1(p1)
  58   call achar_a1(p1)
  59   !
  60   sm => cm(n)
  61   if(.not.associated(sm))              stop 9
  62   if(.not.associated(sm, cm(n)))       stop 10
  63   if(len(sm)/=m)                       stop 11
  64   if(sm/=cm(n))                        stop 12
  65   call schar_cm(sm)
  66   call schar_am(sm)
  67   pm => cm
  68   if(.not.associated(pm))              stop 13
  69   if(.not.associated(pm, cm))          stop 14
  70   if(len(pm)/=m)                       stop 15
  71   if(any(pm/=cm))                      stop 16
  72   call achar_cm(pm)
  73   call achar_am(pm)
  74   !
  75   se => cm(n)(l:u)
  76   if(.not.associated(se))              stop 17
  77   if(.not.associated(se, cm(n)(l:u)))  stop 18
  78   if(len(se)/=e)                       stop 19
  79   if(se/=cm(n)(l:u))                   stop 20
  80   call schar_ce(se)
  81   call schar_ae(se)
  82   pe => cm(:)(l:u)
  83   if(.not.associated(pe))              stop 21
  84   if(.not.associated(pe, cm(:)(l:u)))  stop 22
  85   if(len(pe)/=e)                       stop 23
  86   if(any(pe/=cm(:)(l:u)))              stop 24
  87   call achar_ce(pe)
  88   call achar_ae(pe)
  89   !
  90   sd => c1(n)
  91   if(.not.associated(sd))              stop 25
  92   if(.not.associated(sd, c1(n)))       stop 26
  93   if(len(sd)/=1)                       stop 27
  94   if(sd/=c1(n))                        stop 28
  95   call schar_d1(sd)
  96   pd => c1
  97   if(.not.associated(pd))              stop 29
  98   if(.not.associated(pd, c1))          stop 30
  99   if(len(pd)/=1)                       stop 31
 100   if(any(pd/=c1))                      stop 32
 101   call achar_d1(pd)
 102   !
 103   sd => cm(n)
 104   if(.not.associated(sd))              stop 33
 105   if(.not.associated(sd, cm(n)))       stop 34
 106   if(len(sd)/=m)                       stop 35
 107   if(sd/=cm(n))                        stop 36
 108   call schar_dm(sd)
 109   pd => cm
 110   if(.not.associated(pd))              stop 37
 111   if(.not.associated(pd, cm))          stop 38
 112   if(len(pd)/=m)                       stop 39
 113   if(any(pd/=cm))                      stop 40
 114   call achar_dm(pd)
 115   !
 116   sd => cm(n)(l:u)
 117   if(.not.associated(sd))              stop 41
 118   if(.not.associated(sd, cm(n)(l:u)))  stop 42
 119   if(len(sd)/=e)                       stop 43
 120   if(sd/=cm(n)(l:u))                   stop 44
 121   call schar_de(sd)
 122   pd => cm(:)(l:u)
 123   if(.not.associated(pd))              stop 45
 124   if(.not.associated(pd, cm(:)(l:u)))  stop 46
 125   if(len(pd)/=e)                       stop 47
 126   if(any(pd/=cm(:)(l:u)))              stop 48
 127   call achar_de(pd)
 128   !
 129   sd => c1(n)
 130   s1 => sd
 131   if(.not.associated(s1))              stop 49
 132   if(.not.associated(s1, c1(n)))       stop 50
 133   if(len(s1)/=1)                       stop 51
 134   if(s1/=c1(n))                        stop 52
 135   call schar_c1(s1)
 136   call schar_a1(s1)
 137   pd => c1
 138   s1 => pd(n)
 139   if(.not.associated(s1))              stop 53
 140   if(.not.associated(s1, c1(n)))       stop 54
 141   if(len(s1)/=1)                       stop 55
 142   if(s1/=c1(n))                        stop 56
 143   call schar_c1(s1)
 144   call schar_a1(s1)
 145   pd => c1
 146   p1 => pd
 147   if(.not.associated(p1))              stop 57
 148   if(.not.associated(p1, c1))          stop 58
 149   if(len(p1)/=1)                       stop 59
 150   if(any(p1/=c1))                      stop 60
 151   call achar_c1(p1)
 152   call achar_a1(p1)
 153   !
 154   sd => cm(n)
 155   sm => sd
 156   if(.not.associated(sm))              stop 61
 157   if(.not.associated(sm, cm(n)))       stop 62
 158   if(len(sm)/=m)                       stop 63
 159   if(sm/=cm(n))                        stop 64
 160   call schar_cm(sm)
 161   call schar_am(sm)
 162   pd => cm
 163   sm => pd(n)
 164   if(.not.associated(sm))              stop 65
 165   if(.not.associated(sm, cm(n)))       stop 66
 166   if(len(sm)/=m)                       stop 67
 167   if(sm/=cm(n))                        stop 68
 168   call schar_cm(sm)
 169   call schar_am(sm)
 170   pd => cm
 171   pm => pd
 172   if(.not.associated(pm))              stop 69
 173   if(.not.associated(pm, cm))          stop 70
 174   if(len(pm)/=m)                       stop 71
 175   if(any(pm/=cm))                      stop 72
 176   call achar_cm(pm)
 177   call achar_am(pm)
 178   !
 179   sd => cm(n)(l:u)
 180   se => sd
 181   if(.not.associated(se))              stop 73
 182   if(.not.associated(se, cm(n)(l:u)))  stop 74
 183   if(len(se)/=e)                       stop 75
 184   if(se/=cm(n)(l:u))                   stop 76
 185   call schar_ce(se)
 186   call schar_ae(se)
 187   pd => cm(:)(l:u)
 188   pe => pd
 189   if(.not.associated(pe))              stop 77
 190   if(.not.associated(pe, cm(:)(l:u)))  stop 78
 191   if(len(pe)/=e)                       stop 79
 192   if(any(pe/=cm(:)(l:u)))              stop 80
 193   call achar_ce(pe)
 194   call achar_ae(pe)
 195   !
 196   su => c1(n)
 197   if(.not.associated(su))              stop 81
 198   if(.not.associated(su, c1(n)))       stop 82
 199   select type(su)
 200   type is(character(len=*, kind=k))
 201     if(len(su)/=1)                     stop 83
 202     if(su/=c1(n))                      stop 84
 203   class default
 204     stop 85
 205   end select
 206   call schar_u1(su)
 207   pu => c1
 208   if(.not.associated(pu))              stop 86
 209   if(.not.associated(pu, c1))          stop 87
 210   select type(pu)
 211   type is(character(len=*, kind=k))
 212     if(len(pu)/=1)                     stop 88
 213     if(any(pu/=c1))                    stop 89
 214   class default
 215     stop 90
 216   end select
 217   call achar_u1(pu)
 218   !
 219   su => cm(n)
 220   if(.not.associated(su))              stop 91
 221   if(.not.associated(su))              stop 92
 222   if(.not.associated(su, cm(n)))       stop 93
 223   select type(su)
 224   type is(character(len=*, kind=k))
 225     if(len(su)/=m)                     stop 94
 226     if(su/=cm(n))                      stop 95
 227   class default
 228     stop 96
 229   end select
 230   call schar_um(su)
 231   pu => cm
 232   if(.not.associated(pu))              stop 97
 233   if(.not.associated(pu, cm))          stop 98
 234   select type(pu)
 235   type is(character(len=*, kind=k))
 236     if(len(pu)/=m)                     stop 99
 237     if(any(pu/=cm))                    stop 100
 238   class default
 239     stop 101
 240   end select
 241   call achar_um(pu)
 242   !
 243   su => cm(n)(l:u)
 244   if(.not.associated(su))              stop 102
 245   if(.not.associated(su, cm(n)(l:u)))  stop 103
 246   select type(su)
 247   type is(character(len=*, kind=k))
 248     if(len(su)/=e)                     stop 104
 249     if(su/=cm(n)(l:u))                 stop 105
 250   class default
 251     stop 106
 252   end select
 253   call schar_ue(su)
 254   pu => cm(:)(l:u)
 255   if(.not.associated(pu))              stop 107
 256   if(.not.associated(pu, cm(:)(l:u)))  stop 108
 257   select type(pu)
 258   type is(character(len=*, kind=k))
 259     if(len(pu)/=e)                     stop 109
 260     if(any(pu/=cm(:)(l:u)))            stop 110
 261   class default
 262     stop 111
 263   end select
 264   call achar_ue(pu)
 265   !
 266   sd => c1(n)
 267   su => sd
 268   if(.not.associated(su))              stop 112
 269   if(.not.associated(su, c1(n)))       stop 113
 270   select type(su)
 271   type is(character(len=*, kind=k))
 272     if(len(su)/=1)                     stop 114
 273     if(su/=c1(n))                      stop 115
 274   class default
 275     stop 116
 276   end select
 277   call schar_u1(su)
 278   pd => c1
 279   su => pd(n)
 280   if(.not.associated(su))              stop 117
 281   if(.not.associated(su, c1(n)))       stop 118
 282   select type(su)
 283   type is(character(len=*, kind=k))
 284     if(len(su)/=1)                     stop 119
 285     if(su/=c1(n))                      stop 120
 286   class default
 287     stop 121
 288   end select
 289   call schar_u1(su)
 290   pd => c1
 291   pu => pd
 292   if(.not.associated(pu))              stop 122
 293   if(.not.associated(pu, c1))          stop 123
 294   select type(pu)
 295   type is(character(len=*, kind=k))
 296     if(len(pu)/=1)                     stop 124
 297     if(any(pu/=c1))                    stop 125
 298   class default
 299     stop 126
 300   end select
 301   call achar_u1(pu)
 302   !
 303   sd => cm(n)
 304   su => sd
 305   if(.not.associated(su))              stop 127
 306   if(.not.associated(su, cm(n)))       stop 128
 307   select type(su)
 308   type is(character(len=*, kind=k))
 309     if(len(su)/=m)                     stop 129
 310     if(su/=cm(n))                      stop 130
 311   class default
 312     stop 131
 313   end select
 314   call schar_um(su)
 315   pd => cm
 316   su => pd(n)
 317   if(.not.associated(su))              stop 132
 318   if(.not.associated(su, cm(n)))       stop 133
 319   select type(su)
 320   type is(character(len=*, kind=k))
 321     if(len(su)/=m)                     stop 134
 322     if(su/=cm(n))                      stop 135
 323   class default
 324     stop 136
 325   end select
 326   call schar_um(su)
 327   pd => cm
 328   pu => pd
 329   if(.not.associated(pu))              stop 137
 330   if(.not.associated(pu, cm))          stop 138
 331   select type(pu)
 332   type is(character(len=*, kind=k))
 333     if(len(pu)/=m)                     stop 139
 334     if(any(pu/=cm))                    stop 140
 335   class default
 336     stop 141
 337   end select
 338   call achar_um(pu)
 339   !
 340   sd => cm(n)(l:u)
 341   su => sd
 342   if(.not.associated(su))              stop 142
 343   if(.not.associated(su, cm(n)(l:u)))  stop 143
 344   select type(su)
 345   type is(character(len=*, kind=k))
 346     if(len(su)/=e)                     stop 144
 347     if(su/=cm(n)(l:u))                 stop 145
 348   class default
 349     stop 146
 350   end select
 351   call schar_ue(su)
 352   pd => cm(:)(l:u)
 353   su => pd(n)
 354   if(.not.associated(su))              stop 147
 355   if(.not.associated(su, cm(n)(l:u)))  stop 148
 356   select type(su)
 357   type is(character(len=*, kind=k))
 358     if(len(su)/=e)                     stop 149
 359     if(su/=cm(n)(l:u))                 stop 150
 360   class default
 361     stop 151
 362   end select
 363   call schar_ue(su)
 364   pd => cm(:)(l:u)
 365   pu => pd
 366   if(.not.associated(pu))              stop 152
 367   if(.not.associated(pu, cm(:)(l:u)))  stop 153
 368   select type(pu)
 369   type is(character(len=*, kind=k))
 370     if(len(pu)/=e)                     stop 154
 371     if(any(pu/=cm(:)(l:u)))            stop 155
 372   class default
 373     stop 156
 374   end select
 375   call achar_ue(pu)
 376   !
 377   sd => cm(n)
 378   su => sd(l:u)
 379   if(.not.associated(su))              stop 157
 380   if(.not.associated(su, cm(n)(l:u)))  stop 158
 381   select type(su)
 382   type is(character(len=*, kind=k))
 383     if(len(su)/=e)                     stop 159
 384     if(su/=cm(n)(l:u))                 stop 160
 385   class default
 386     stop 161
 387   end select
 388   call schar_ue(su)
 389   pd => cm(:)
 390   su => pd(n)(l:u)
 391   if(.not.associated(su))              stop 162
 392   if(.not.associated(su, cm(n)(l:u)))  stop 163
 393   select type(su)
 394   type is(character(len=*, kind=k))
 395     if(len(su)/=e)                     stop 164
 396     if(su/=cm(n)(l:u))                 stop 165
 397   class default
 398     stop 166
 399   end select
 400   call schar_ue(su)
 401   pd => cm
 402   pu => pd(:)(l:u)
 403   if(.not.associated(pu))              stop 167
 404   if(.not.associated(pu, cm(:)(l:u)))  stop 168
 405   select type(pu)
 406   type is(character(len=*, kind=k))
 407     if(len(pu)/=e)                     stop 169
 408     if(any(pu/=cm(:)(l:u)))            stop 170
 409   class default
 410     stop 171
 411   end select
 412   call achar_ue(pu)
 413   !
 414   stop
 415
 416 contains
 417
 418   subroutine schar_c1(a)
 419     character(kind=k), pointer, intent(in) :: a
 420
 421     if(.not.associated(a))             stop 172
 422     if(.not.associated(a, c1(n)))      stop 173
 423     if(len(a)/=1)                      stop 174
 424     if(a/=c1(n))                       stop 175
 425     return
 426   end subroutine schar_c1
 427
 428   subroutine achar_c1(a)
 429     character(kind=k), pointer, intent(in) :: a(:)
 430
 431     if(.not.associated(a))             stop 176
 432     if(.not.associated(a, c1))         stop 177
 433     if(len(a)/=1)                      stop 178
 434     if(any(a/=c1))                     stop 179
 435     return
 436   end subroutine achar_c1
 437
 438   subroutine schar_cm(a)
 439     character(kind=k, len=m), pointer, intent(in) :: a
 440
 441     if(.not.associated(a))             stop 180
 442     if(.not.associated(a, cm(n)))      stop 181
 443     if(len(a)/=m)                      stop 182
 444     if(a/=cm(n))                       stop 183
 445     return
 446   end subroutine schar_cm
 447
 448   subroutine achar_cm(a)
 449     character(kind=k, len=m), pointer, intent(in) :: a(:)
 450
 451     if(.not.associated(a))             stop 184
 452     if(.not.associated(a, cm))         stop 185
 453     if(len(a)/=m)                      stop 186
 454     if(any(a/=cm))                     stop 187
 455     return
 456   end subroutine achar_cm
 457
 458   subroutine schar_ce(a)
 459     character(kind=k, len=e), pointer, intent(in) :: a
 460
 461     if(.not.associated(a))             stop 188
 462     if(.not.associated(a, cm(n)(l:u))) stop 189
 463     if(len(a)/=e)                      stop 190
 464     if(a/=cm(n)(l:u))                  stop 191
 465     return
 466   end subroutine schar_ce
 467
 468   subroutine achar_ce(a)
 469     character(kind=k, len=e), pointer, intent(in) :: a(:)
 470
 471     if(.not.associated(a))             stop 192
 472     if(.not.associated(a, cm(:)(l:u))) stop 193
 473     if(len(a)/=e)                      stop 194
 474     if(any(a/=cm(:)(l:u)))             stop 195
 475     return
 476   end subroutine achar_ce
 477
 478   subroutine schar_a1(a)
 479     character(kind=k, len=*), pointer, intent(in) :: a
 480
 481     if(.not.associated(a))             stop 196
 482     if(.not.associated(a, c1(n)))      stop 197
 483     if(len(a)/=1)                      stop 198
 484     if(a/=c1(n))                       stop 199
 485     return
 486   end subroutine schar_a1
 487
 488   subroutine achar_a1(a)
 489     character(kind=k, len=*), pointer, intent(in) :: a(:)
 490
 491     if(.not.associated(a))             stop 200
 492     if(.not.associated(a, c1))         stop 201
 493     if(len(a)/=1)                      stop 202
 494     if(any(a/=c1))                     stop 203
 495     return
 496   end subroutine achar_a1
 497
 498   subroutine schar_am(a)
 499     character(kind=k, len=*), pointer, intent(in) :: a
 500
 501     if(.not.associated(a))             stop 204
 502     if(.not.associated(a, cm(n)))      stop 205
 503     if(len(a)/=m)                      stop 206
 504     if(a/=cm(n))                       stop 207
 505     return
 506   end subroutine schar_am
 507
 508   subroutine achar_am(a)
 509     character(kind=k, len=*), pointer, intent(in) :: a(:)
 510
 511     if(.not.associated(a))             stop 208
 512     if(.not.associated(a, cm))         stop 209
 513     if(len(a)/=m)                      stop 210
 514     if(any(a/=cm))                     stop 211
 515     return
 516   end subroutine achar_am
 517
 518   subroutine schar_ae(a)
 519     character(kind=k, len=*), pointer, intent(in) :: a
 520
 521     if(.not.associated(a))             stop 212
 522     if(.not.associated(a, cm(n)(l:u))) stop 213
 523     if(len(a)/=e)                      stop 214
 524     if(a/=cm(n)(l:u))                  stop 215
 525     return
 526   end subroutine schar_ae
 527
 528   subroutine achar_ae(a)
 529     character(kind=k, len=*), pointer, intent(in) :: a(:)
 530
 531     if(.not.associated(a))             stop 216
 532     if(.not.associated(a, cm(:)(l:u))) stop 217
 533     if(len(a)/=e)                      stop 218
 534     if(any(a/=cm(:)(l:u)))             stop 219
 535     return
 536   end subroutine achar_ae
 537
 538   subroutine schar_d1(a)
 539     character(kind=k, len=:), pointer, intent(in) :: a
 540
 541     if(.not.associated(a))             stop 220
 542     if(.not.associated(a, c1(n)))      stop 221
 543     if(len(a)/=1)                      stop 222
 544     if(a/=c1(n))                       stop 223
 545     return
 546   end subroutine schar_d1
 547
 548   subroutine achar_d1(a)
 549     character(kind=k, len=:), pointer, intent(in) :: a(:)
 550
 551     if(.not.associated(a))             stop 224
 552     if(.not.associated(a, c1))         stop 225
 553     if(len(a)/=1)                      stop 226
 554     if(any(a/=c1))                     stop 227
 555     return
 556   end subroutine achar_d1
 557
 558   subroutine schar_dm(a)
 559     character(kind=k, len=:), pointer, intent(in) :: a
 560
 561     if(.not.associated(a))             stop 228
 562     if(.not.associated(a, cm(n)))      stop 229
 563     if(len(a)/=m)                      stop 230
 564     if(a/=cm(n))                       stop 231
 565     return
 566   end subroutine schar_dm
 567
 568   subroutine achar_dm(a)
 569     character(kind=k, len=:), pointer, intent(in) :: a(:)
 570
 571     if(.not.associated(a))             stop 232
 572     if(.not.associated(a, cm))         stop 233
 573     if(len(a)/=m)                      stop 234
 574     if(any(a/=cm))                     stop 235
 575     return
 576   end subroutine achar_dm
 577
 578   subroutine schar_de(a)
 579     character(kind=k, len=:), pointer, intent(in) :: a
 580
 581     if(.not.associated(a))             stop 236
 582     if(.not.associated(a, cm(n)(l:u))) stop 237
 583     if(len(a)/=e)                      stop 238
 584     if(a/=cm(n)(l:u))                  stop 239
 585     return
 586   end subroutine schar_de
 587
 588   subroutine achar_de(a)
 589     character(kind=k, len=:), pointer, intent(in) :: a(:)
 590
 591     if(.not.associated(a))             stop 240
 592     if(.not.associated(a, cm(:)(l:u))) stop 241
 593     if(len(a)/=e)                      stop 242
 594     if(any(a/=cm(:)(l:u)))             stop 243
 595     return
 596   end subroutine achar_de
 597
 598   subroutine schar_u1(a)
 599     class(*), pointer, intent(in) :: a
 600
 601     if(.not.associated(a))             stop 244
 602     if(.not.associated(a, c1(n)))      stop 245
 603     select type(a)
 604     type is(character(len=*, kind=k))
 605       if(len(a)/=1)                    stop 246
 606       if(a/=c1(n))                     stop 247
 607     class default
 608       stop 248
 609     end select
 610     return
 611   end subroutine schar_u1
 612
 613   subroutine achar_u1(a)
 614     class(*), pointer, intent(in) :: a(:)
 615
 616     if(.not.associated(a))             stop 249
 617     if(.not.associated(a, c1))         stop 250
 618     select type(a)
 619     type is(character(len=*, kind=k))
 620       if(len(a)/=1)                    stop 251
 621       if(any(a/=c1))                   stop 252
 622     class default
 623       stop 253
 624     end select
 625     return
 626   end subroutine achar_u1
 627
 628   subroutine schar_um(a)
 629     class(*), pointer, intent(in) :: a
 630
 631     if(.not.associated(a))             stop 254
 632     if(.not.associated(a))             stop 255
 633     if(.not.associated(a, cm(n)))      stop 256
 634     select type(a)
 635     type is(character(len=*, kind=k))
 636       if(len(a)/=m)                    stop 257
 637       if(a/=cm(n))                     stop 258
 638     class default
 639       stop 259
 640     end select
 641     return
 642   end subroutine schar_um
 643
 644   subroutine achar_um(a)
 645     class(*), pointer, intent(in) :: a(:)
 646
 647     if(.not.associated(a))             stop 260
 648     if(.not.associated(a, cm))         stop 261
 649     select type(a)
 650     type is(character(len=*, kind=k))
 651       if(len(a)/=m)                    stop 262
 652       if(any(a/=cm))                   stop 263
 653     class default
 654       stop 264
 655     end select
 656     return
 657   end subroutine achar_um
 658
 659   subroutine schar_ue(a)
 660     class(*), pointer, intent(in) :: a
 661
 662     if(.not.associated(a))             stop 265
 663     if(.not.associated(a, cm(n)(l:u))) stop 266
 664     select type(a)
 665     type is(character(len=*, kind=k))
 666       if(len(a)/=e)                    stop 267
 667       if(a/=cm(n)(l:u))                stop 268
 668     class default
 669       stop 269
 670     end select
 671     return
 672   end subroutine schar_ue
 673
 674   subroutine achar_ue(a)
 675     class(*), pointer, intent(in) :: a(:)
 676
 677     if(.not.associated(a))             stop 270
 678     if(.not.associated(a, cm(:)(l:u))) stop 271
 679     select type(a)
 680     type is(character(len=*, kind=k))
 681       if(len(a)/=e)                    stop 272
 682       if(any(a/=cm(:)(l:u)))           stop 273
 683     class default
 684       stop 274
 685     end select
 686     return
 687   end subroutine achar_ue
 688
 689 end program main_p