view gcc/testsuite/gfortran.dg/ISO_Fortran_binding_12.f90 @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents
children
line wrap: on
line source

! { dg-do run { target c99_runtime } }
! { dg-additional-sources ISO_Fortran_binding_12.c }
!
! Test the fix for PR90093. The additional source is the main program.
!
! Contributed by Reinhold Bader  <Bader@lrz.de>
!
module mod_optional
  use, intrinsic :: iso_c_binding
  implicit none
  integer :: status = 0

contains

  subroutine foo_opt(this, that, sz, flag) bind(c)
    real(c_float), optional :: this(:)
    real(c_float), optional :: that(*)
    integer(c_int), optional :: sz
    integer(c_int), value :: flag
    if (flag == 0) then
       if (.not. present(this) .or. present(that) .or. present(sz)) then
          write(*,*) 'FAIL 1', present(this), present(that), present(sz)
          status = status + 1
       end if
    else if (flag == 1) then
       if (present(this) .or. .not. present(that) .or. .not. present(sz)) then
          write(*,*) 'FAIL 2', present(this), present(that), present(sz)
          status = status + 1
       end if
       if (sz /= 12) then
          write(*,*) 'FAIL 3'
          status = status + 1
       end if
    else if (flag == 2) then
       if (present(this) .or. present(that) .or. present(sz)) then
          write(*,*) 'FAIL 4', present(this), present(that), present(sz)
          status = status + 1
       end if
    end if
  end subroutine foo_opt

  subroutine write_res() BIND(C)
! Add a check that the fortran missing optional is accepted by the
! bind(C) procedure.
    call foo_opt (flag = 2)
    if (status == 0) then
       write(*,*) 'OK'
    else
       stop 1
    end if
  end subroutine

end module mod_optional