gcc/testsuite/gfortran.dg/intrinsic_pack_4.f90

   1 ! { dg-do run }
   2 ! PR 35990 - some empty array sections caused pack to crash.
   3 ! Test case contributed by Dick Hendrickson, adjusted and
   4 ! extended by Thomas Koenig.
   5       program try_gf1048
   6
   7       call       gf1048a(  10,  8,  7,  1,  0,  .true.)
   8       call       gf1048b(  10,  8,  7,  1,  0,  .true.)
   9       call       gf1048c(  10,  8,  7,  1,  0,  .true.)
  10       call       gf1048d(  10,  8,  7,  1,  0,  .true.)
  11       call       P_inta (  10,  8,  7,  1,  0,  .true.)
  12       call       P_intb (  10,  8,  7,  1,  0,  .true.)
  13       call       P_intc (  10,  8,  7,  1,  0,  .true.)
  14       call       P_intd (  10,  8,  7,  1,  0,  .true.)
  15       end program
  16
  17       SUBROUTINE GF1048a(nf10,nf8,nf7,nf1,nf0,nf_true)
  18       logical nf_true
  19       CHARACTER(9) BDA(10)
  20       CHARACTER(9) BDA1(10)
  21       BDA(  8:7) = PACK(BDA1( 10:  1), NF_TRUE)
  22       END SUBROUTINE
  23
  24       SUBROUTINE GF1048b(nf10,nf8,nf7,nf1,nf0,nf_true)
  25       logical nf_true
  26       CHARACTER(9) BDA(10)
  27       CHARACTER(9) BDA1(nf10)
  28       BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
  29       END SUBROUTINE
  30
  31       SUBROUTINE GF1048c(nf10,nf8,nf7,nf1,nf0,nf_true)
  32       logical nf_true
  33       CHARACTER(9) BDA(10)
  34       CHARACTER(9) BDA1(10)
  35       BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
  36       END SUBROUTINE
  37
  38       SUBROUTINE GF1048d(nf10,nf8,nf7,nf1,nf0,nf_true)
  39       logical nf_true
  40       CHARACTER(9) BDA(10)
  41       CHARACTER(9) BDA1(nf10)
  42       BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
  43       END SUBROUTINE
  44
  45       SUBROUTINE P_INTa(nf10,nf8,nf7,nf1,nf0,nf_true)
  46       logical nf_true
  47       INTEGER BDA(10)
  48       INTEGER BDA1(10)
  49       BDA(  8:7) = PACK(BDA1( 10:  1), NF_TRUE)
  50       END SUBROUTINE
  51
  52       SUBROUTINE P_INTb(nf10,nf8,nf7,nf1,nf0,nf_true)
  53       logical nf_true
  54       INTEGER BDA(10)
  55       INTEGER BDA1(nf10)
  56       BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
  57       END SUBROUTINE
  58
  59       SUBROUTINE P_INTc(nf10,nf8,nf7,nf1,nf0,nf_true)
  60       logical nf_true
  61       INTEGER BDA(10)
  62       INTEGER BDA1(10)
  63       BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
  64       END SUBROUTINE
  65
  66       SUBROUTINE P_INTd(nf10,nf8,nf7,nf1,nf0,nf_true)
  67       logical nf_true
  68       INTEGER BDA(10)
  69       INTEGER BDA1(nf10)
  70       BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
  71       END SUBROUTINE
  72