Commit f27fc94c authored by Henderson, Shane's avatar Henderson, Shane
Browse files

Merge branch 'hotfix_libpng' into 'master' 

Hotfix to libpng interfaces

See merge request https://code.ornl.gov/futility/Futility/-/merge_requests/422
parents 255516c2 c49730dc

src/FileType_PNG.f90

+46 −27
Original line number Diff line number Diff line
@@ -85,13 +85,19 @@ CHARACTER(LEN=EXCEPTION_MAX_MESG_LENGTH) :: emesg 
!Version 1.6.34 is the version of libpng distributed with RHEL8.

!libng 1.6.x is backwards compatible to 1.0.7 or 1.0.69 depending on how you read png.h



CHARACTER(LEN=*,KIND=C_CHAR),PARAMETER :: F_PNG_LIBVER_STRING="1.6.34"//C_NULL_CHAR !PNG_LIBPNG_VER_STRING

INTEGER(C_INT),PARAMETER :: F_PNG_COLOR_TYPE_RGB=2  !Must be same value as PNG_COLOR_TYPE_RGB in png.h

INTEGER(C_INT),PARAMETER :: F_PNG_BIT_DEPTH=8       !This module only supports 8-bit





!Define Fortran-C interfaces to libpng common to reading and writing

INTERFACE

 !Get PNG Version number

  FUNCTION C_png_get_libpng_ver(png_ptr) BIND(C,name="png_get_libpng_ver")

    IMPORT :: C_PTR

    TYPE(C_PTR) :: C_png_get_libpng_ver

    TYPE(C_PTR),VALUE :: png_ptr

  ENDFUNCTION C_png_get_libpng_ver



  !Initialize PNG info structure

  FUNCTION C_png_create_info_struct(png_ptr) BIND(C,NAME="png_create_info_struct")

    IMPORT :: C_PTR
@@ -238,9 +244,9 @@ SUBROUTINE writeImageData_PNGFileType(this,image) 
  INTEGER(C_INT),PARAMETER :: compression_method=0 ! PNG_COMPRESSION_TYPE_DEFAULT

  INTEGER(C_INT),PARAMETER :: filter_method=0      ! PNG_FILTER_TYPE_DEFAULT



  CHARACTER(LEN=1,KIND=C_CHAR),POINTER :: pngbytep(:,:,:)

  CHARACTER(LEN=1,KIND=C_CHAR),POINTER :: pngbytep(:,:,:),png_ver(:)

  INTEGER(SIK) :: i,j,width,height

  TYPE(C_PTR) :: png_ptr,info_ptr

  TYPE(C_PTR) :: png_ptr,info_ptr,ver_ptr

  TYPE(C_PTR),POINTER :: row_pointers(:)



  ! Define Fortran-C interfaces to libpng routines for writing an image
@@ -285,9 +291,9 @@ SUBROUTINE writeImageData_PNGFileType(this,image) 
    ENDSUBROUTINE C_png_write_end



    !Destroy PNG write structure

    SUBROUTINE C_png_destroy_write_struct(png_ptr,info_ptr_ptr) BIND(C,NAME="png_destroy_write_struct")

    SUBROUTINE C_png_destroy_write_struct(png_ptr_ptr,info_ptr_ptr) BIND(C,NAME="png_destroy_write_struct")

      IMPORT :: C_PTR

      TYPE(C_PTR),VALUE :: png_ptr

      TYPE(C_PTR) :: png_ptr_ptr

      TYPE(C_PTR) :: info_ptr_ptr

    ENDSUBROUTINE C_png_destroy_write_struct

  ENDINTERFACE
@@ -307,9 +313,15 @@ SUBROUTINE writeImageData_PNGFileType(this,image) 
    ENDDO

  ENDDO



  ! Get the PNG version

  ver_ptr=C_png_get_libpng_ver(C_NULL_PTR)

  CALL C_F_POINTER(ver_ptr,png_ver,(/16/)) !This is for the length of the version string

                                           !16 is chosen as it should always be long enough

                                           !7 is more likely, but going to 16 doesn't seem

                                           !cause an issue.



  ! Create the PNG write structure

  png_ptr=C_png_create_write_struct(F_PNG_LIBVER_STRING//C_NULL_CHAR, &

    C_NULL_PTR,C_NULL_PTR,C_NULL_PTR)

  png_ptr=C_png_create_write_struct(png_ver,C_NULL_PTR,C_NULL_PTR,C_NULL_PTR)

  IF(.NOT.C_ASSOCIATED(png_ptr)) THEN

    WRITE(emesg,'(a)') "Error creating PNG write struct!"

    CALL this%e%raiseError(modName//'::'//myName//' - '//emesg)
@@ -393,11 +405,11 @@ SUBROUTINE readImageData_PNGFileType(this,image) 


  CHARACTER(LEN=*),PARAMETER :: myName='readImageData_PNGFileType'

  CHARACTER(KIND=C_CHAR),TARGET :: header(8)

  CHARACTER(LEN=1,KIND=C_CHAR),POINTER :: pngbytep(:,:,:)

  CHARACTER(LEN=1,KIND=C_CHAR),POINTER :: pngbytep(:,:,:),png_ver(:)

  INTEGER(C_SIZE_T) :: rbytes

  INTEGER(C_INT) :: ioerr,width,height,color_type,bit_depth



  TYPE(C_PTR) :: png_ptr,info_ptr

  TYPE(C_PTR) :: png_ptr,info_ptr,ver_ptr

  TYPE(C_PTR),POINTER :: row_pointers(:)



  INTEGER(SIK) :: i,j
@@ -505,7 +517,14 @@ SUBROUTINE readImageData_PNGFileType(this,image) 
    CALL this%e%raiseError(modName//'::'//myName//' - '//emesg)

  ENDIF



  png_ptr=C_png_create_read_struct(F_PNG_LIBVER_STRING,C_NULL_PTR,C_NULL_PTR,C_NULL_PTR)

  ! Get the PNG version

  ver_ptr=C_png_get_libpng_ver(C_NULL_PTR)

  CALL C_F_POINTER(ver_ptr,png_ver,(/16/)) !This is for the length of the version string

                                           !16 is chosen as it should always be long enough

                                           !7 is more likely, but going to 16 doesn't seem

                                           !cause an issue.



  png_ptr=C_png_create_read_struct(png_ver,C_NULL_PTR,C_NULL_PTR,C_NULL_PTR)

  IF(.NOT.C_ASSOCIATED(png_ptr)) THEN

    WRITE(emesg,'(a)') "Error creating PNG read struct!"

    CALL this%e%raiseError(modName//'::'//myName//' - '//emesg)

unit_tests/testTPLPNG/testTPLPNGf.f90

+14 −7
Original line number Diff line number Diff line
@@ -20,6 +20,13 @@ PROGRAM testTPLPNGf 
        TYPE(C_PTR),value :: stream

      ENDFUNCTION C_fclose



      ! Get PNG Version number

      FUNCTION C_png_get_libpng_ver(png_ptr) BIND(C,name="png_get_libpng_ver")

        IMPORT :: C_PTR

        TYPE(C_PTR) :: C_png_get_libpng_ver

        TYPE(C_PTR),VALUE :: png_ptr

      ENDFUNCTION C_png_get_libpng_ver



      ! Initialize PNG write structure

      FUNCTION C_png_create_write_struct(ver,err_ptr,wrn_ptr,mem_ptr) BIND(C,NAME="png_create_write_struct")

        IMPORT :: C_PTR, C_CHAR
@@ -72,8 +79,8 @@ PROGRAM testTPLPNGf 
      ! Destroy PNG write structure

      SUBROUTINE C_png_destroy_write_struct(png_ptr,info_ptr_ptr) BIND(C,NAME="png_destroy_write_struct")

        IMPORT :: C_PTR

        TYPE(C_PTR),VALUE :: png_ptr

        TYPE(C_PTR), dimension(*) :: info_ptr_ptr

        TYPE(C_PTR) :: png_ptr

        TYPE(C_PTR) :: info_ptr_ptr

      ENDSUBROUTINE C_png_destroy_write_struct

   ENDINTERFACE