COMPRESSION: Pass the input length to compress().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-28 22:19:50 -03:00
parent 20282539f9
commit e6fc8e5d24
2 changed files with 18 additions and 14 deletions

View File

@ -212,11 +212,14 @@ module compression
! !
! Arguments: ! Arguments:
! !
! input - the input sequence of bytes; ! input - the input sequence of bytes;
! ilen - the length of input;
! output - the compressed sequence of bytes;
! csize - the length of compressed sequence;
! !
!=============================================================================== !===============================================================================
! !
subroutine compress(input, output, csize) subroutine compress(input, ilen, output, csize)
use iso_c_binding, only: c_int, c_loc use iso_c_binding, only: c_int, c_loc
#ifdef LZ4 #ifdef LZ4
@ -226,6 +229,7 @@ module compression
implicit none implicit none
integer(kind=1), dimension(:), target, intent(in) :: input integer(kind=1), dimension(:), target, intent(in) :: input
integer(kind=8) , intent(in) :: ilen
integer(kind=1), dimension(:), target, intent(out) :: output integer(kind=1), dimension(:), target, intent(out) :: output
integer(kind=8) , target, intent(out) :: csize integer(kind=8) , target, intent(out) :: csize
@ -241,13 +245,13 @@ module compression
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
csize = min(size(input, kind=8), size(output, kind=8)) csize = min(ilen, size(output, kind=8))
select case(compression_format) select case(compression_format)
#ifdef ZSTD #ifdef ZSTD
case(compression_zstd) case(compression_zstd)
allocate(buffer(zstd_bound(size(input, kind=8)))) allocate(buffer(zstd_bound(ilen)))
csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), & csize = zstd_compress(c_loc(buffer), size(buffer, kind=8), &
c_loc(input), size(input, kind=8), & c_loc(input), ilen, &
compression_level) compression_level)
if (csize > 0 .and. csize <= size(output, kind=8)) then if (csize > 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)
@ -258,11 +262,11 @@ module compression
#endif /* ZSTD */ #endif /* ZSTD */
#ifdef LZ4 #ifdef LZ4
case(compression_lz4) case(compression_lz4)
prefs(5:6) = transfer(size(input, kind=8), [ 0_4 ]) prefs(5:6) = transfer(ilen, [ 0_4 ])
prefs(9) = compression_level prefs(9) = compression_level
allocate(buffer(lz4_bound(size(input, kind=8), c_loc(prefs)))) allocate(buffer(lz4_bound(ilen, c_loc(prefs))))
csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), & csize = lz4_compress(c_loc(buffer), size(buffer, kind=8), &
c_loc(input), size(input, kind=8), c_loc(prefs)) c_loc(input), ilen, c_loc(prefs))
if (csize > 0 .and. csize <= size(output, kind=8)) then if (csize > 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)
else else
@ -273,9 +277,9 @@ module compression
#ifdef LZMA #ifdef LZMA
case(compression_lzma) case(compression_lzma)
csize = 0 csize = 0
allocate(buffer(size(input))) allocate(buffer(ilen))
ret = lzma_compress(compression_level, 4, c_null_ptr, & ret = lzma_compress(compression_level, 4, c_null_ptr, &
c_loc(input), size(input, kind=8), & c_loc(input), ilen, &
c_loc(buffer), c_loc(csize), size(buffer, kind=8)) c_loc(buffer), c_loc(csize), size(buffer, kind=8))
if (ret == 0 .and. csize <= size(output, kind=8)) then if (ret == 0 .and. csize <= size(output, kind=8)) then
output(1:csize) = buffer(1:csize) output(1:csize) = buffer(1:csize)

View File

@ -2843,7 +2843,7 @@ module io
if (present(compressed_bytes) .and. get_compression() > 0) then if (present(compressed_bytes) .and. get_compression() > 0) then
allocate(buffer(array_bytes), stat = status) allocate(buffer(array_bytes), stat = status)
if (status == 0) then if (status == 0) then
call compress(array, buffer, compressed_bytes) call compress(array, array_bytes, buffer, compressed_bytes)
if (compressed_bytes > 0) then if (compressed_bytes > 0) then
open(newunit = lun, file = fname, form = 'unformatted', & open(newunit = lun, file = fname, form = 'unformatted', &
access = 'stream', status = 'replace') access = 'stream', status = 'replace')