! { dg-do run } ! PR 35990 - some empty array sections caused pack to crash. ! Test case contributed by Dick Hendrickson, adjusted and ! extended by Thomas Koenig. program try_gf1048 call gf1048a( 10, 8, 7, 1, 0, .true.) call gf1048b( 10, 8, 7, 1, 0, .true.) call gf1048c( 10, 8, 7, 1, 0, .true.) call gf1048d( 10, 8, 7, 1, 0, .true.) call P_inta ( 10, 8, 7, 1, 0, .true.) call P_intb ( 10, 8, 7, 1, 0, .true.) call P_intc ( 10, 8, 7, 1, 0, .true.) call P_intd ( 10, 8, 7, 1, 0, .true.) end program SUBROUTINE GF1048a(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true CHARACTER(9) BDA(10) CHARACTER(9) BDA1(10) BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE) END SUBROUTINE SUBROUTINE GF1048b(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true CHARACTER(9) BDA(10) CHARACTER(9) BDA1(nf10) BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE) END SUBROUTINE SUBROUTINE GF1048c(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true CHARACTER(9) BDA(10) CHARACTER(9) BDA1(10) BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE) END SUBROUTINE SUBROUTINE GF1048d(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true CHARACTER(9) BDA(10) CHARACTER(9) BDA1(nf10) BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE) END SUBROUTINE SUBROUTINE P_INTa(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true INTEGER BDA(10) INTEGER BDA1(10) BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE) END SUBROUTINE SUBROUTINE P_INTb(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true INTEGER BDA(10) INTEGER BDA1(nf10) BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE) END SUBROUTINE SUBROUTINE P_INTc(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true INTEGER BDA(10) INTEGER BDA1(10) BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE) END SUBROUTINE SUBROUTINE P_INTd(nf10,nf8,nf7,nf1,nf0,nf_true) logical nf_true INTEGER BDA(10) INTEGER BDA1(nf10) BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE) END SUBROUTINE