gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90

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