├── .gitignore ├── LICENCE ├── Makefile ├── README.md ├── fpm.toml ├── src └── zlib.f90 └── test ├── test.txt └── test_zlib.f90 /.gitignore: -------------------------------------------------------------------------------- 1 | *.a 2 | *.so 3 | 4 | # Distribution / packaging 5 | env/ 6 | build/ 7 | dist/ 8 | var/ 9 | 10 | # Other stuff 11 | *.swp 12 | *.mod 13 | *.o 14 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2022, Philipp Engel 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .POSIX: 2 | .SUFFIXES: 3 | 4 | FC = gfortran 5 | AR = ar 6 | PREFIX = /usr/local 7 | 8 | DEBUG = -g -O0 -Wall -fmax-errors=1 9 | RELEASE = -O2 10 | 11 | FFLAGS = $(RELEASE) 12 | LDFLAGS = -I$(PREFIX)/include -L$(PREFIX)/lib 13 | LDLIBS = -lz 14 | ARFLAGS = rcs 15 | INCDIR = $(PREFIX)/include/libfortran-zlib 16 | LIBDIR = $(PREFIX)/lib 17 | MODULE = zlib.mod 18 | TARGET = ./libfortran-zlib.a 19 | SHARED = ./libfortran-zlib.so 20 | 21 | .PHONY: all clean install shared test test_shared 22 | 23 | all: $(TARGET) 24 | 25 | shared: $(SHARED) 26 | 27 | $(TARGET): src/zlib.f90 28 | $(FC) $(FFLAGS) -c src/zlib.f90 29 | $(AR) $(ARFLAGS) $(TARGET) zlib.o 30 | 31 | $(SHARED): src/zlib.f90 32 | $(FC) $(FFLAGS) -fPIC -shared -o $(SHARED) src/zlib.f90 $(LDLIBS) 33 | 34 | test: $(TARGET) test/test_zlib.f90 35 | $(FC) $(FFLAGS) $(LDFLAGS) -o test_zlib test/test_zlib.f90 $(TARGET) $(LDLIBS) 36 | 37 | test_shared: $(SHARED) test/test_zlib.f90 38 | $(FC) $(FFLAGS) $(LDFLAGS) -o test_zlib_shared test/test_zlib.f90 $(SHARED) $(LDLIBS) 39 | 40 | install: $(TARGET) 41 | @echo "--- Installing libraries to $(LIBDIR)/ ..." 42 | install -d $(LIBDIR) 43 | install -m 644 $(TARGET) $(LIBDIR)/ 44 | if [ -e $(SHARED) ]; then install -m 644 $(SHARED) $(LIBDIR)/; fi 45 | @echo "--- Installing module files to $(INCDIR)/ ..." 46 | install -d $(INCDIR) 47 | install -m 644 $(MODULE) $(INCDIR)/ 48 | 49 | clean: 50 | if [ `ls -1 *.mod 2>/dev/null | wc -l` -gt 0 ]; then rm *.mod; fi 51 | if [ `ls -1 *.o 2>/dev/null | wc -l` -gt 0 ]; then rm *.o; fi 52 | if [ -e $(TARGET) ]; then rm $(TARGET); fi 53 | if [ -e $(SHARED) ]; then rm $(SHARED); fi 54 | if [ -e test_zlib ]; then rm test_zlib; fi 55 | if [ -e test_zlib_shared ]; then rm test_zlib_shared; fi 56 | if [ -e test2.txt ]; then rm test2.txt; fi 57 | if [ -e test.txt.z ]; then rm test.txt.z; fi 58 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fortran-zlib 2 | 3 | A collection of Fortran 2018 interface bindings to selected zlib functions. The 4 | library is also available on [MacPorts](https://ports.macports.org/port/fortran-zlib/). 5 | 6 | ## Build Instructions 7 | 8 | Build and install the library with the provided Makefile: 9 | 10 | ``` 11 | $ make 12 | $ make install PREFIX=/opt 13 | ``` 14 | 15 | Link your program against `/opt/lib/libfortran-zlib.a -lz`. Optionally, 16 | overwrite the default compiler: 17 | 18 | ``` 19 | $ make FC=ifx 20 | ``` 21 | 22 | Or, use the [Fortran Package Manager](https://github.com/fortran-lang/fpm): 23 | 24 | ``` 25 | $ fpm build --profile release 26 | ``` 27 | 28 | Build and run the test program: 29 | 30 | ``` 31 | $ make test 32 | $ ./test_zlib 33 | ``` 34 | 35 | ## Example 36 | 37 | The following basic example compresses and uncompresses an input string. 38 | 39 | ```fortran 40 | ! example.f90 41 | program main 42 | use :: zlib 43 | implicit none (type, external) 44 | 45 | character(len=:), allocatable :: str_in, str_out, str_x 46 | integer(kind=z_ulong) :: len_in, len_out, len_x 47 | integer :: rc 48 | 49 | ! Input. 50 | str_in = repeat('Fortran ', 10) 51 | len_in = len(str_in, kind=z_ulong) 52 | 53 | ! Compress. 54 | len_x = compress_bound(len_in) 55 | allocate (character(len=len_x) :: str_x) 56 | rc = compress(str_x, len_x, str_in, len_in) 57 | if (rc /= Z_OK) stop 'Error: compress() failed' 58 | 59 | ! Uncompress. 60 | len_out = len_in 61 | allocate (character(len=len_out) :: str_out) 62 | rc = uncompress(str_out, len_out, str_x, len_x) 63 | if (rc /= Z_OK) stop 'Error: uncompress() failed' 64 | end program main 65 | ``` 66 | 67 | If the library has been installed to `/opt`, then compile, link, and run the 68 | example program with: 69 | 70 | ``` 71 | $ gfortran -I/opt/include/libfortran-zlib -o example example.f90 /opt/lib/libfortran-zlib.a -lz 72 | $ ./example 73 | ``` 74 | 75 | ## Coverage 76 | 77 | | C function | Fortran interface | 78 | |-----------------|-------------------| 79 | | `adler32` | `adler32` | 80 | | `adler32_z` | `adler32_z` | 81 | | `compress` | `compress` | 82 | | `compress2` | `compress2` | 83 | | `compressBound` | `compress_bound` | 84 | | `crc32` | `crc32` | 85 | | `crc32_z` | `crc32_z` | 86 | | `deflate` | `deflate` | 87 | | `deflateEnd` | `deflate_end` | 88 | | `deflateInit` | `deflate_init` | 89 | | `deflateInit2` | `deflate_init2` | 90 | | `inflate` | `inflate` | 91 | | `inflateEnd` | `inflate_end` | 92 | | `inflateInit` | `inflate_init` | 93 | | `inflateInit2` | `inflate_init2` | 94 | | `uncompress` | `uncompress` | 95 | | `uncompress2` | `uncompress2` | 96 | 97 | ## Fortran Package Manager 98 | 99 | You can add *fortran-zlib* as an *fpm* dependency: 100 | 101 | ```toml 102 | [dependencies] 103 | fortran-zlib = { git = "https://github.com/interkosmos/fortran-zlib.git" } 104 | ``` 105 | 106 | ## Licence 107 | 108 | ISC 109 | -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "fortran-zlib" 2 | version = "0.2.0" 3 | license = "ISC" 4 | author = "Philipp Engel" 5 | maintainer = "@interkosmos" 6 | copyright = "Copyright (c) 2022, Philipp Engel" 7 | description = "Fortran 2018 ISO C binding interfaces to zlib" 8 | keywords = ["zlib"] 9 | 10 | [build] 11 | link = "z" 12 | 13 | [library] 14 | source-dir = "src" 15 | 16 | [install] 17 | library = true 18 | 19 | [[test]] 20 | name = "test_zlib" 21 | source-dir = "test" 22 | main = "test_zlib.f90" 23 | -------------------------------------------------------------------------------- /src/zlib.f90: -------------------------------------------------------------------------------- 1 | ! zlib.f90 2 | ! 3 | ! Fortran 2018 interface bindings to zlib. 4 | ! 5 | ! Author: Philipp Engel 6 | ! Licence: ISC 7 | module zlib 8 | use, intrinsic :: iso_c_binding 9 | implicit none (type, external) 10 | private 11 | 12 | integer, parameter, public :: z_byte = c_char 13 | integer, parameter, public :: z_size_t = c_size_t 14 | integer, parameter, public :: z_uint = c_int 15 | integer, parameter, public :: z_ulong = c_long 16 | 17 | integer(kind=c_int), parameter, public :: Z_NO_FLUSH = 0 18 | integer(kind=c_int), parameter, public :: Z_PARTIAL_FLUSH = 1 19 | integer(kind=c_int), parameter, public :: Z_SYNC_FLUSH = 2 20 | integer(kind=c_int), parameter, public :: Z_FULL_FLUSH = 3 21 | integer(kind=c_int), parameter, public :: Z_FINISH = 4 22 | integer(kind=c_int), parameter, public :: Z_BLOCK = 5 23 | integer(kind=c_int), parameter, public :: Z_TREES = 6 24 | 25 | integer(kind=c_int), parameter, public :: Z_OK = 0 26 | integer(kind=c_int), parameter, public :: Z_STREAM_END = 1 27 | integer(kind=c_int), parameter, public :: Z_NEED_DICT = 2 28 | integer(kind=c_int), parameter, public :: Z_ERRNO = -1 29 | integer(kind=c_int), parameter, public :: Z_STREAM_ERROR = -2 30 | integer(kind=c_int), parameter, public :: Z_DATA_ERROR = -3 31 | integer(kind=c_int), parameter, public :: Z_MEM_ERROR = -4 32 | integer(kind=c_int), parameter, public :: Z_BUF_ERROR = -5 33 | integer(kind=c_int), parameter, public :: Z_VERSION_ERROR = -6 34 | 35 | integer(kind=c_int), parameter, public :: Z_NO_COMPRESSION = 0 36 | integer(kind=c_int), parameter, public :: Z_BEST_SPEED = 1 37 | integer(kind=c_int), parameter, public :: Z_BEST_COMPRESSION = 9 38 | integer(kind=c_int), parameter, public :: Z_DEFAULT_COMPRESSION = -1 39 | 40 | integer(kind=c_int), parameter, public :: Z_FILTERED = 1 41 | integer(kind=c_int), parameter, public :: Z_HUFFMAN_ONLY = 2 42 | integer(kind=c_int), parameter, public :: Z_RLE = 3 43 | integer(kind=c_int), parameter, public :: Z_FIXED = 4 44 | integer(kind=c_int), parameter, public :: Z_DEFAULT_STRATEGY = 0 45 | 46 | integer(kind=c_int), parameter, public :: Z_BINARY = 0 47 | integer(kind=c_int), parameter, public :: Z_TEXT = 1 48 | integer(kind=c_int), parameter, public :: Z_ASCII = Z_TEXT 49 | integer(kind=c_int), parameter, public :: Z_UNKNOWN = 2 50 | 51 | integer(kind=c_int), parameter, public :: Z_DEFLATED = 8 52 | 53 | type, bind(c), public :: z_stream_type 54 | type(c_ptr) :: next_in = c_null_ptr 55 | integer(kind=z_uint) :: avail_in = 0 56 | integer(kind=z_ulong) :: total_in = 0 57 | type(c_ptr) :: next_out = c_null_ptr 58 | integer(kind=z_uint) :: avail_out = 0 59 | integer(kind=z_ulong) :: total_out = 0 60 | type(c_ptr) :: msg = c_null_ptr 61 | type(c_ptr) :: state = c_null_ptr 62 | type(c_funptr) :: zalloc = c_null_funptr 63 | type(c_funptr) :: zfree = c_null_funptr 64 | type(c_ptr) :: opaque = c_null_ptr 65 | integer(kind=c_int) :: data_type = 0 66 | integer(kind=z_ulong) :: adler = 0 67 | integer(kind=z_ulong) :: reserved = 0 68 | end type z_stream_type 69 | 70 | public :: adler32 71 | public :: adler32_z 72 | public :: compress 73 | public :: compress2 74 | public :: compress_bound 75 | public :: crc32 76 | public :: crc32_z 77 | public :: deflate 78 | public :: deflate_end 79 | public :: deflate_init 80 | public :: deflate_init2 81 | public :: inflate 82 | public :: inflate_end 83 | public :: inflate_init 84 | public :: inflate_init2 85 | public :: uncompress 86 | public :: uncompress2 87 | 88 | interface 89 | ! uLong adler32(uLong adler, const Bytef *buf, uInt len) 90 | function adler32(adler, buf, len) bind(c, name='adler32') 91 | import :: z_byte, z_uint, z_ulong 92 | implicit none 93 | integer(kind=z_ulong), intent(in), value :: adler 94 | character(kind=z_byte), intent(in) :: buf 95 | integer(kind=z_uint), intent(in), value :: len 96 | integer(kind=z_ulong) :: adler32 97 | end function adler32 98 | 99 | ! uLong adler32_z(uLong adler, const Bytef *buf, z_size_t len) 100 | function adler32_z(adler, buf, len) bind(c, name='adler32_z') 101 | import :: z_byte, z_size_t, z_ulong 102 | implicit none 103 | integer(kind=z_ulong), intent(in), value :: adler 104 | character(kind=z_byte), intent(in) :: buf 105 | integer(kind=z_size_t), intent(in), value :: len 106 | integer(kind=z_ulong) :: adler32_z 107 | end function adler32_z 108 | 109 | ! int compress(Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) 110 | function compress(dest, dest_len, source, source_len) bind(c, name='compress') 111 | import :: c_int, z_byte, z_ulong 112 | implicit none 113 | character(kind=z_byte), intent(inout) :: dest 114 | integer(kind=z_ulong), intent(inout) :: dest_len 115 | character(kind=z_byte), intent(in) :: source 116 | integer(kind=z_ulong), intent(in), value :: source_len 117 | integer(kind=c_int) :: compress 118 | end function compress 119 | 120 | ! int compress2(Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen, int level) 121 | function compress2(dest, dest_len, source, source_len, level) bind(c, name='compress2') 122 | import :: c_int, z_byte, z_ulong 123 | implicit none 124 | character(kind=z_byte), intent(inout) :: dest 125 | integer(kind=z_ulong), intent(inout) :: dest_len 126 | character(kind=z_byte), intent(in) :: source 127 | integer(kind=z_ulong), intent(in), value :: source_len 128 | integer(kind=c_int), intent(in), value :: level 129 | integer(kind=c_int) :: compress2 130 | end function compress2 131 | 132 | ! uLong compressBound(uLong sourceLen) 133 | function compress_bound(source_len) bind(c, name='compressBound') 134 | import :: z_ulong 135 | implicit none 136 | integer(kind=z_ulong), intent(in), value :: source_len 137 | integer(kind=z_ulong) :: compress_bound 138 | end function compress_bound 139 | 140 | ! uLong crc32(uLong adler, const Bytef *buf, uInt len) 141 | function crc32(adler, buf, len) bind(c, name='crc32') 142 | import :: z_byte, z_uint, z_ulong 143 | implicit none 144 | integer(kind=z_ulong), intent(in), value :: adler 145 | character(kind=z_byte), intent(in) :: buf 146 | integer(kind=z_uint), intent(in), value :: len 147 | integer(kind=z_ulong) :: crc32 148 | end function crc32 149 | 150 | ! uLong crc32_z(uLong adler, const Bytef *buf, z_size_t len) 151 | function crc32_z(adler, buf, len) bind(c, name='crc32_z') 152 | import :: z_byte, z_size_t, z_ulong 153 | implicit none 154 | integer(kind=z_ulong), intent(in), value :: adler 155 | character(kind=z_byte), intent(in) :: buf 156 | integer(kind=z_size_t), intent(in), value :: len 157 | integer(kind=z_ulong) :: crc32_z 158 | end function crc32_z 159 | 160 | ! int deflate(z_streamp strm, int flush) 161 | function deflate(strm, flush) bind(c, name='deflate') 162 | import :: c_int, z_stream_type 163 | implicit none 164 | type(z_stream_type), intent(inout) :: strm 165 | integer(kind=c_int), intent(in), value :: flush 166 | integer(kind=c_int) :: deflate 167 | end function deflate 168 | 169 | ! int deflateEnd(z_streamp strm) 170 | function deflate_end(strm) bind(c, name='deflateEnd') 171 | import :: c_int, z_stream_type 172 | implicit none 173 | type(z_stream_type), intent(inout) :: strm 174 | integer(kind=c_int) :: deflate_end 175 | end function deflate_end 176 | 177 | ! int deflateInit_(z_streamp strm, int level, const char *version, int stream_size) 178 | function deflate_init_(strm, level, version, stream_size) bind(c, name='deflateInit_') 179 | import :: c_int, c_ptr, z_stream_type 180 | implicit none 181 | type(z_stream_type), intent(inout) :: strm 182 | integer(kind=c_int), intent(in), value :: level 183 | type(c_ptr), intent(in), value :: version 184 | integer(kind=c_int), intent(in), value :: stream_size 185 | integer(kind=c_int) :: deflate_init_ 186 | end function deflate_init_ 187 | 188 | ! int deflateInit2_(z_streamp strm, int level, int method, int windowBits, int memLevel, 189 | ! int strategy, const char *version, int stream_size) 190 | function deflate_init2_(strm, level, method, window_bits, mem_level, strategy, & 191 | version, stream_size) bind(c, name='deflateInit2_') 192 | import :: c_int, c_ptr, z_stream_type 193 | implicit none 194 | type(z_stream_type), intent(inout) :: strm 195 | integer(kind=c_int), intent(in), value :: level 196 | integer(kind=c_int), intent(in), value :: method 197 | integer(kind=c_int), intent(in), value :: window_bits 198 | integer(kind=c_int), intent(in), value :: mem_level 199 | integer(kind=c_int), intent(in), value :: strategy 200 | type(c_ptr), intent(in), value :: version 201 | integer(kind=c_int), intent(in), value :: stream_size 202 | integer(kind=c_int) :: deflate_init2_ 203 | end function deflate_init2_ 204 | 205 | ! int inflate(z_streamp strm, int flush) 206 | function inflate(strm, flush) bind(c, name='inflate') 207 | import :: c_int, z_stream_type 208 | implicit none 209 | type(z_stream_type), intent(inout) :: strm 210 | integer(kind=c_int), intent(in), value :: flush 211 | integer(kind=c_int) :: inflate 212 | end function inflate 213 | 214 | ! int inflateEnd(z_streamp strm) 215 | function inflate_end(strm) bind(c, name='inflateEnd') 216 | import :: c_int, z_stream_type 217 | implicit none 218 | type(z_stream_type), intent(inout) :: strm 219 | integer(kind=c_int) :: inflate_end 220 | end function inflate_end 221 | 222 | ! int inflateInit_(z_streamp strm, const char *version, int stream_size) 223 | function inflate_init_(strm, version, stream_size) bind(c, name='inflateInit_') 224 | import :: c_int, c_ptr, z_stream_type 225 | implicit none 226 | type(z_stream_type), intent(inout) :: strm 227 | type(c_ptr), intent(in), value :: version 228 | integer(kind=c_int), intent(in), value :: stream_size 229 | integer(kind=c_int) :: inflate_init_ 230 | end function inflate_init_ 231 | 232 | ! int inflateInit2_(z_streamp strm, int windowBits, const char *version, int stream_size) 233 | function inflate_init2_(strm, window_bits, version, stream_size) bind(c, name='inflateInit2_') 234 | import :: c_int, c_ptr, z_stream_type 235 | implicit none 236 | type(z_stream_type), intent(inout) :: strm 237 | integer(kind=c_int), intent(in), value :: window_bits 238 | type(c_ptr), intent(in), value :: version 239 | integer(kind=c_int), intent(in), value :: stream_size 240 | integer(kind=c_int) :: inflate_init2_ 241 | end function inflate_init2_ 242 | 243 | ! int uncompress(Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen) 244 | function uncompress(dest, dest_len, source, source_len) bind(c, name='uncompress') 245 | import :: c_int, z_byte, z_ulong 246 | implicit none 247 | character(kind=z_byte), intent(inout) :: dest 248 | integer(kind=z_ulong), intent(inout) :: dest_len 249 | character(kind=z_byte), intent(in) :: source 250 | integer(kind=z_ulong), intent(in), value :: source_len 251 | integer(kind=c_int) :: uncompress 252 | end function uncompress 253 | 254 | ! int uncompress2(Bytef *dest, uLongf *destLen, const Bytef *source, uLong *sourceLen) 255 | function uncompress2(dest, dest_len, source, source_len) bind(c, name='uncompress2') 256 | import :: c_int, z_byte, z_ulong 257 | implicit none 258 | character(kind=z_byte), intent(inout) :: dest 259 | integer(kind=z_ulong), intent(inout) :: dest_len 260 | character(kind=z_byte), intent(in) :: source 261 | integer(kind=z_ulong), intent(inout) :: source_len 262 | integer(kind=c_int) :: uncompress2 263 | end function uncompress2 264 | 265 | function zlib_version_() bind(c, name='zlibVersion') 266 | import :: c_ptr 267 | implicit none 268 | type(c_ptr) :: zlib_version_ 269 | end function zlib_version_ 270 | end interface 271 | contains 272 | ! int deflateInit(z_streamp strm, int level) 273 | integer function deflate_init(strm, level) result(rc) 274 | type(z_stream_type), intent(inout) :: strm 275 | integer, intent(in) :: level 276 | 277 | rc = deflate_init_(strm, level, zlib_version_(), int(c_sizeof(strm), kind=c_int)) 278 | end function deflate_init 279 | 280 | ! int deflateInit2(z_streamp strm, int level, int method, int windowBits, int memLevel, int strategy) 281 | integer function deflate_init2(strm, level, method, window_bits, mem_level, strategy) result(rc) 282 | type(z_stream_type), intent(inout) :: strm 283 | integer, intent(in) :: level 284 | integer, intent(in) :: method 285 | integer, intent(in) :: window_bits 286 | integer, intent(in) :: mem_level 287 | integer, intent(in) :: strategy 288 | 289 | rc = deflate_init2_(strm, level, method, window_bits, mem_level, & 290 | strategy, zlib_version_(), int(c_sizeof(strm), kind=c_int)) 291 | end function deflate_init2 292 | 293 | ! int inflateInit(z_streamp strm) 294 | integer function inflate_init(strm) result(rc) 295 | type(z_stream_type), intent(inout) :: strm 296 | 297 | rc = inflate_init_(strm, zlib_version_(), int(c_sizeof(strm), kind=c_int)) 298 | end function inflate_init 299 | 300 | ! int inflateInit2(z_streamp strm, int windowBits) 301 | integer function inflate_init2(strm, window_bits) result(rc) 302 | type(z_stream_type), intent(inout) :: strm 303 | integer, intent(in) :: window_bits 304 | 305 | rc = inflate_init2_(strm, window_bits, zlib_version_(), int(c_sizeof(strm), kind=c_int)) 306 | end function inflate_init2 307 | end module zlib 308 | -------------------------------------------------------------------------------- /test/test.txt: -------------------------------------------------------------------------------- 1 | Now is the time for all good men to come to the aid of the party. 2 | Now is the time for all good men to come to the aid of the party. 3 | Now is the time for all good men to come to the aid of the party. 4 | Now is the time for all good men to come to the aid of the party. 5 | Now is the time for all good men to come to the aid of the party. 6 | Now is the time for all good men to come to the aid of the party. 7 | Now is the time for all good men to come to the aid of the party. 8 | Now is the time for all good men to come to the aid of the party. 9 | Now is the time for all good men to come to the aid of the party. 10 | Now is the time for all good men to come to the aid of the party. 11 | -------------------------------------------------------------------------------- /test/test_zlib.f90: -------------------------------------------------------------------------------- 1 | program test_zlib 2 | use, intrinsic :: iso_c_binding, only: c_loc 3 | use :: zlib 4 | implicit none (type, external) 5 | 6 | integer, parameter :: CHUNK_LEN = 16384 7 | 8 | character(len=*), parameter :: SRC_FILE = 'test/test.txt' 9 | character(len=*), parameter :: DST_FILE = 'test.txt.z' 10 | character(len=*), parameter :: DST_FILE2 = 'test2.txt' 11 | 12 | character(len=*), parameter :: SRC_IN1 = & 13 | 'Now is the time for all good men to come to the aid of the party.' 14 | character(len=*), parameter :: SRC_IN2 = repeat(SRC_IN1 // ' ', 10) 15 | 16 | integer(kind=z_ulong), parameter :: SRC_A32 = int(z'E9DD1697', kind=z_ulong) 17 | integer(kind=z_ulong), parameter :: SRC_CRC = int(z'93D6A5C9', kind=z_ulong) 18 | 19 | character(len=:), allocatable :: in1, out1, out2, out3, out4 20 | integer :: rc, sz, sz1, sz2 21 | integer(kind=z_ulong) :: a32, c32, sz3, sz4 22 | logical :: exists 23 | 24 | ! Adler32 checksum (must be initialised to 1). 25 | a32 = adler32(1_z_ulong, SRC_IN1, len(SRC_IN1)) 26 | if (a32 /= SRC_A32) stop 'Error: adler32() failed' 27 | 28 | a32 = adler32_z(1_z_ulong, SRC_IN1, len(SRC_IN1, kind=z_ulong)) 29 | if (a32 /= SRC_A32) stop 'Error: adler32_z() failed' 30 | 31 | ! CRC32 checksum (must be initialised to 0). 32 | c32 = crc32(0_z_ulong, SRC_IN1, len(SRC_IN1)) 33 | if (c32 /= SRC_CRC) stop 'Error: crc32() failed' 34 | 35 | c32 = crc32_z(0_z_ulong, SRC_IN1, len(SRC_IN1, kind=z_ulong)) 36 | if (c32 /= SRC_CRC) stop 'Error: crc32_z() failed' 37 | 38 | print '("Adler32..........: 0x", z0)', a32 39 | print '("CRC32............: 0x", z0)', c32 40 | 41 | ! Deflate/inflate file. 42 | inquire (exist=exists, file=SRC_FILE, size=sz) 43 | if (.not. exists) stop 'Error: input file not found' 44 | 45 | rc = z_deflate_file(SRC_FILE, DST_FILE, Z_DEFAULT_COMPRESSION) 46 | if (rc /= Z_OK) stop 'Error: z_deflate_file() failed' 47 | 48 | inquire (exist=exists, file=DST_FILE, size=sz1) 49 | if (.not. exists) stop 'Error: deflated file not found' 50 | 51 | rc = z_inflate_file(DST_FILE, DST_FILE2) 52 | if (rc /= Z_OK) stop 'Error: z_inflate_file() failed' 53 | 54 | inquire (exist=exists, file=DST_FILE2, size=sz2) 55 | if (.not. exists) stop 'Error: inflated file not found' 56 | 57 | if (sz /= sz2) stop 'Error: file sizes do not match' 58 | 59 | print '("input file size..: ", i0)', sz 60 | print '("deflate file size: ", i0)', sz1 61 | print '("inflate file size: ", i0)', sz2 62 | 63 | ! Deflate/inflate memory. 64 | rc = z_deflate_mem(SRC_IN2, out1, Z_DEFAULT_COMPRESSION) 65 | if (rc /= Z_OK) stop 'Error: z_deflate_mem() failed' 66 | 67 | rc = z_inflate_mem(out1, out2, len(SRC_IN2) * 2) 68 | if (rc /= Z_OK) stop 'Error: z_inflate_mem() failed' 69 | 70 | if (out2 /= SRC_IN2) stop 'Error: data mismatch' 71 | 72 | print '("input size.......: ", i0)', len(SRC_IN2) 73 | print '("deflate size.....: ", i0)', len(out1) 74 | print '("inflate size.....: ", i0)', len(out2) 75 | 76 | ! Compress. 77 | sz3 = compress_bound(len(SRC_IN2, kind=z_ulong)) 78 | allocate (character(len=sz3) :: out3) 79 | rc = compress(out3, sz3, SRC_IN2, len(SRC_IN2, kind=z_ulong)) 80 | if (rc /= Z_OK) stop 'Error: compress() failed' 81 | 82 | ! Uncompress. 83 | sz4 = len(SRC_IN2) 84 | allocate (character(len=sz4) :: out4) 85 | rc = uncompress(out4, sz4, out3, sz3) 86 | if (rc /= Z_OK) stop 'Error: uncompress() failed' 87 | 88 | print '("input size.......: ", i0)', len(SRC_IN2) 89 | print '("compress size....: ", i0)', sz3 90 | print '("uncompress size..: ", i0)', sz4 91 | 92 | if (sz4 /= len(SRC_IN2)) stop 'Error: data mismatch' 93 | contains 94 | integer function z_deflate_file(source, dest, level) result(rc) 95 | character(len=*), intent(in) :: source 96 | character(len=*), intent(in) :: dest 97 | integer, intent(in) :: level 98 | 99 | character(len=CHUNK_LEN), target :: in, out 100 | character :: byte 101 | integer :: err, flush, have 102 | integer :: i, n 103 | integer :: in_unit, out_unit 104 | type(z_stream_type) :: strm 105 | 106 | rc = deflate_init(strm, level) 107 | if (rc /= Z_OK) return 108 | 109 | def_block: block 110 | rc = Z_ERRNO 111 | 112 | open (access='stream', action='read', file=source, form='unformatted', & 113 | iostat=err, newunit=in_unit, status='old') 114 | if (err /= 0) exit def_block 115 | 116 | open (access='stream', action='write', file=dest, form='unformatted', & 117 | iostat=err, newunit=out_unit, status='replace') 118 | if (err /= 0) exit def_block 119 | 120 | do 121 | n = 0 122 | flush = Z_NO_FLUSH 123 | 124 | do i = 1, CHUNK_LEN 125 | read (in_unit, iostat=err) byte 126 | 127 | if (is_iostat_end(err)) then 128 | flush = Z_FINISH 129 | exit 130 | end if 131 | 132 | in(i:i) = byte 133 | n = n + 1 134 | end do 135 | 136 | strm%avail_in = n 137 | strm%next_in = c_loc(in) 138 | 139 | do 140 | strm%avail_out = CHUNK_LEN 141 | strm%next_out = c_loc(out) 142 | 143 | rc = deflate(strm, flush) 144 | if (rc == Z_STREAM_ERROR) exit def_block 145 | 146 | have = CHUNK_LEN - strm%avail_out 147 | write (out_unit, iostat=err) out(1:have) 148 | 149 | if (err /= 0) exit def_block 150 | if (strm%avail_out /= 0) exit 151 | end do 152 | 153 | if (strm%avail_in /= 0) exit def_block 154 | if (flush == Z_FINISH) exit 155 | end do 156 | 157 | if (rc /= Z_STREAM_END) exit def_block 158 | rc = Z_OK 159 | end block def_block 160 | 161 | err = deflate_end(strm) 162 | close (out_unit) 163 | close (in_unit) 164 | end function z_deflate_file 165 | 166 | integer function z_deflate_mem(source, dest, level) result(rc) 167 | character(len=*), target, intent(in) :: source 168 | character(len=:), allocatable, intent(out) :: dest 169 | integer, intent(in) :: level 170 | 171 | character(len=len(source)), target :: buffer 172 | integer :: err, have 173 | type(z_stream_type) :: strm 174 | 175 | dest = '' 176 | 177 | rc = deflate_init(strm, level) 178 | if (rc /= Z_OK) return 179 | 180 | def_block: block 181 | strm%total_in = len(source) 182 | strm%avail_in = len(source) 183 | strm%next_in = c_loc(source) 184 | 185 | strm%total_out = len(buffer) 186 | strm%avail_out = len(buffer) 187 | strm%next_out = c_loc(buffer) 188 | 189 | rc = deflate(strm, Z_FINISH) 190 | if (rc == Z_STREAM_ERROR) exit def_block 191 | 192 | have = len(buffer) - strm%avail_out 193 | dest = buffer(1:have) 194 | 195 | if (rc /= Z_STREAM_END) exit def_block 196 | rc = Z_OK 197 | end block def_block 198 | 199 | err = deflate_end(strm) 200 | end function z_deflate_mem 201 | 202 | integer function z_inflate_file(source, dest) result(rc) 203 | character(len=*), intent(in) :: source 204 | character(len=*), intent(in) :: dest 205 | 206 | character(len=CHUNK_LEN), target :: in, out 207 | character :: byte 208 | integer :: err, have 209 | integer :: i, n 210 | integer :: in_unit, out_unit 211 | type(z_stream_type) :: strm 212 | 213 | rc = inflate_init(strm) 214 | if (rc /= Z_OK) return 215 | 216 | inf_block: block 217 | rc = Z_ERRNO 218 | 219 | open (access='stream', action='read', file=source, form='unformatted', & 220 | iostat=err, newunit=in_unit, status='old') 221 | if (err /= 0) exit inf_block 222 | 223 | open (access='stream', action='write', file=dest, form='unformatted', & 224 | iostat=err, newunit=out_unit, status='replace') 225 | if (err /= 0) exit inf_block 226 | 227 | do 228 | n = 0 229 | 230 | do i = 1, CHUNK_LEN 231 | read (in_unit, iostat=err) byte 232 | if (is_iostat_end(err)) exit 233 | 234 | in(i:i) = byte 235 | n = n + 1 236 | end do 237 | 238 | strm%avail_in = n 239 | strm%next_in = c_loc(in) 240 | 241 | do 242 | strm%avail_out = CHUNK_LEN 243 | strm%next_out = c_loc(out) 244 | 245 | rc = inflate(strm, Z_NO_FLUSH) 246 | 247 | if (rc == Z_STREAM_ERROR) exit inf_block 248 | if (rc == Z_NEED_DICT) exit inf_block 249 | if (rc == Z_DATA_ERROR) exit inf_block 250 | if (rc == Z_MEM_ERROR) exit inf_block 251 | 252 | have = CHUNK_LEN - strm%avail_out 253 | write (out_unit, iostat=err) out(1:have) 254 | 255 | if (err /= 0) exit inf_block 256 | if (strm%avail_out /= 0) exit 257 | end do 258 | 259 | if (rc == Z_STREAM_END) exit 260 | end do 261 | 262 | rc = Z_OK 263 | end block inf_block 264 | 265 | err = inflate_end(strm) 266 | close (out_unit) 267 | close (in_unit) 268 | end function z_inflate_file 269 | 270 | integer function z_inflate_mem(source, dest, buffer_size) result(rc) 271 | character(len=*), target, intent(in) :: source 272 | character(len=:), allocatable, intent(out) :: dest 273 | integer, intent(in) :: buffer_size 274 | 275 | character(len=buffer_size), target :: buffer 276 | integer :: err, have 277 | type(z_stream_type) :: strm 278 | 279 | dest = '' 280 | 281 | rc = inflate_init(strm) 282 | if (rc /= Z_OK) return 283 | 284 | inf_block: block 285 | strm%total_in = len(source) 286 | strm%avail_in = len(source) 287 | strm%next_in = c_loc(source) 288 | 289 | strm%total_out = len(buffer) 290 | strm%avail_out = len(buffer) 291 | strm%next_out = c_loc(buffer) 292 | 293 | rc = inflate(strm, Z_FINISH) 294 | if (rc == Z_STREAM_ERROR) exit inf_block 295 | 296 | have = len(buffer) - strm%avail_out 297 | dest = buffer(1:have) 298 | 299 | if (rc /= Z_STREAM_END) exit inf_block 300 | rc = Z_OK 301 | end block inf_block 302 | 303 | err = inflate_end(strm) 304 | end function z_inflate_mem 305 | end program test_zlib 306 | --------------------------------------------------------------------------------