intrinsic_pack_4.f90

来自「用于进行gcc测试」· F90 代码 · 共 73 行

! { 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