blob: 89e15e5016814ad48baff7d8b220751ceba54a2e [file] [log] [blame]
! { dg-do compile }
! PR 96843 - this was wrongly rejected.
! Test case by William Clodius.
module test_shape_mismatch
! Implements zero based bitsets of size up to HUGE(0_INT32).
! The current code uses 32 bit integers to store the bits and uses all 32 bits.
! The code assumes two's complement integers, and treats negative integers as
! having the sign bit set.
use, intrinsic :: &
iso_fortran_env, only: &
bits_kind => int32, &
block_kind => int64, &
int8, &
dp => real64
implicit none
private
integer, parameter :: &
block_size = bit_size(0_block_kind), &
block_shift = int( ceiling( log( real(block_size, dp) )/log(2._dp) ) )
public :: bits_kind
! Public constant
public :: bitset_t
! Public type
public :: &
assignment(=)
type, abstract :: bitset_t
private
integer(bits_kind) :: num_bits
end type bitset_t
type, extends(bitset_t) :: bitset_large
private
integer(block_kind), private, allocatable :: blocks(:)
end type bitset_large
interface assign
pure module subroutine assign_log8_large( self, alogical )
!! Used to define assignment from an array of type LOG for bitset_t
type(bitset_large), intent(out) :: self
logical(int8), intent(in) :: alogical(:)
end subroutine assign_log8_large
end interface assign
contains
pure module subroutine assign_log8_large( self, alogical )
! Used to define assignment from an array of type LOG for bitset_t
type(bitset_large), intent(out) :: self
logical(int8), intent(in) :: alogical(:)
integer(bits_kind) :: blocks
integer(bits_kind) :: log_size
integer(bits_kind) :: index
log_size = size( alogical, kind=bits_kind )
self % num_bits = log_size
if ( log_size == 0 ) then
blocks = 0
else
blocks = (log_size-1)/block_size + 1
end if
allocate( self % blocks( blocks ) )
self % blocks(:) = 0
return
end subroutine assign_log8_large
end module test_shape_mismatch