gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90

   1 ! { dg-do compile }
   2 ! Check the fix for PR20893, in which actual arguments could violate:
   3 ! "(5) If it is an array, it shall not be supplied as an actual argument to
   4 ! an elemental procedure unless an array of the same rank is supplied as an
   5 ! actual argument corresponding to a nonoptional dummy argument of that
   6 ! elemental procedure." (12.4.1.5)
   7 !
   8 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   9 !
  10   CALL T1(1,2)
  11 CONTAINS
  12   SUBROUTINE T1(A1,A2,A3)
  13     INTEGER           :: A1,A2, A4(2)
  14     INTEGER, OPTIONAL :: A3(2)
  15     interface
  16       elemental function efoo (B1,B2,B3) result(bar)
  17         INTEGER, intent(in)           :: B1, B2
  18         integer           :: bar
  19         INTEGER, OPTIONAL, intent(in) :: B3
  20       end function efoo
  21     end interface
  22
  23 ! check an intrinsic function
  24     write(6,*) MAX(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
  25     write(6,*) MAX(A1,A3,A2)
  26     write(6,*) MAX(A1,A4,A3)
  27 ! check an internal elemental function
  28     write(6,*) foo(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
  29     write(6,*) foo(A1,A3,A2)
  30     write(6,*) foo(A1,A4,A3)
  31 ! check an external elemental function
  32     write(6,*) efoo(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
  33     write(6,*) efoo(A1,A3,A2)
  34     write(6,*) efoo(A1,A4,A3)
  35 ! check an elemental subroutine
  36     call foobar (A1,A2,A3) ! { dg-error "array and OPTIONAL" }
  37     call foobar (A1,A2,A4)
  38     call foobar (A1,A4,A4)
  39   END SUBROUTINE
  40   elemental function foo (B1,B2,B3) result(bar)
  41     INTEGER, intent(in)           :: B1, B2
  42     integer           :: bar
  43     INTEGER, OPTIONAL, intent(in) :: B3
  44     bar = 1
  45   end function foo
  46   elemental subroutine foobar (B1,B2,B3)
  47     INTEGER, intent(OUT)           :: B1
  48     INTEGER, optional, intent(in)  :: B2, B3
  49     B1 = 1
  50   end subroutine foobar
  51
  52 END