gcc/testsuite/gfortran.dg/entry_6.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR24558, which reported that module
   3 ! alternate function entries did not work.
   4 !
   5 ! Contributed by Erik Edelmann  <eedelman@gcc.gnu.org>
   6 !
   7 module foo
   8 contains
   9     function n1 (a)
  10         integer :: n1, n2, a, b
  11         integer, save :: c
  12         c = a
  13         n1 = c**3
  14         return
  15     entry n2 (b)
  16         n2 = c * b
  17         n2 = n2**2
  18         return
  19     end function n1
  20     function z1 (u)
  21         complex :: z1, z2, u, v
  22         z1 = (1.0, 2.0) * u
  23         return
  24     entry z2 (v)
  25         z2 = (3, 4) * v
  26         return
  27     end function z1
  28     function n3 (d)
  29         integer :: n3, d
  30         n3 = n2(d) * n1(d) ! Check sibling references.
  31         return
  32     end function n3
  33     function c1 (a)
  34         character(4) :: c1, c2, a, b
  35         c1 = a
  36         if (a .eq. "abcd") c1 = "ABCD"
  37         return
  38     entry c2 (b)
  39         c2 = b
  40         if (b .eq. "wxyz") c2 = "WXYZ"
  41         return
  42     end function c1
  43 end module foo
  44     use foo
  45     if (n1(9) .ne. 729) call abort ()
  46     if (n2(2) .ne. 324) call abort ()
  47     if (n3(19) .ne. 200564019) call abort ()
  48     if (c1("lmno") .ne. "lmno") call abort ()
  49     if (c1("abcd") .ne. "ABCD") call abort ()
  50     if (c2("lmno") .ne. "lmno") call abort ()
  51     if (c2("wxyz") .ne. "WXYZ") call abort ()
  52     if (z1((3,4)) .ne. (-5, 10)) call abort ()
  53     if (z2((5,6)) .ne. (-9, 38)) call abort ()
  54  end