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 73