elemental_optional_args_1.f90

来自「用于进行gcc测试」· F90 代码 · 共 54 行

! { dg-do compile }
! { dg-options "-pedantic" }
! Check the fix for PR20893, in which actual arguments could violate: 
! "(5) If it is an array, it shall not be supplied as an actual argument to
! an elemental procedure unless an array of the same rank is supplied as an
! actual argument corresponding to a nonoptional dummy argument of that 
! elemental procedure." (12.4.1.5)
!
! Contributed by Joost VandeVondele <[e-mail]>
!
  CALL T1(1,2)
CONTAINS
  SUBROUTINE T1(A1,A2,A3)
    INTEGER           :: A1,A2, A4(2), A5(2)
    INTEGER, OPTIONAL :: A3(2)
    interface
      elemental function efoo (B1,B2,B3) result(bar)
        INTEGER, intent(in)           :: B1, B2
        integer           :: bar
        INTEGER, OPTIONAL, intent(in) :: B3
      end function efoo
    end interface

! check an intrinsic function
    write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
    write(6,*) MAX(A1,A3,A2)
    write(6,*) MAX(A1,A4,A3)
! check an internal elemental function
    write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
    write(6,*) foo(A1,A3,A2)
    write(6,*) foo(A1,A4,A3)
! check an external elemental function
    write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
    write(6,*) efoo(A1,A3,A2)
    write(6,*) efoo(A1,A4,A3)
! check an elemental subroutine
    call foobar (A5,A2,A4)
    call foobar (A5,A4,A4)
  END SUBROUTINE
  elemental function foo (B1,B2,B3) result(bar)
    INTEGER, intent(in)           :: B1, B2
    integer           :: bar
    INTEGER, OPTIONAL, intent(in) :: B3
    bar = 1
  end function foo
  elemental subroutine foobar (B1,B2,B3)
    INTEGER, intent(OUT)           :: B1
    INTEGER, optional, intent(in)  :: B2, B3
    B1 = 1
  end subroutine foobar

END