Subversion Repositories openrisc_2011-10-31

! { dg-do run }

! { dg-do run }

! { dg-options "-ff2c" }

! { dg-options "-ff2c" }

! Verifies that complex pointer results work with -ff2c

! Verifies that complex pointer results work with -ff2c

! try all permutations of result clause in function yes/no

! try all permutations of result clause in function yes/no

!                     and result clause in interface yes/no

!                     and result clause in interface yes/no

! this is not possible in Fortran 77, but this exercises a previously

! this is not possible in Fortran 77, but this exercises a previously

! buggy codepath

! buggy codepath

function c() result (r)

function c() result (r)

  common // z

  common // z

  complex, pointer :: r

  complex, pointer :: r

  complex, target :: z

  complex, target :: z

  r=>z

  r=>z

end function c

end function c

function d()

function d()

  common // z

  common // z

  complex, pointer :: d

  complex, pointer :: d

  complex, target :: z

  complex, target :: z

  d=>z

  d=>z

end function d

end function d

function e()

function e()

  common // z

  common // z

  complex, pointer :: e

  complex, pointer :: e

  complex, target :: z

  complex, target :: z

  e=>z

  e=>z

end function e

end function e

function f() result(r)

function f() result(r)

  common // z

  common // z

  complex, pointer :: r

  complex, pointer :: r

  complex, target :: z

  complex, target :: z

  r=>z

  r=>z

end function f

end function f

interface

interface

   function c ()

   function c ()

     complex, pointer :: c

     complex, pointer :: c

   end function c

   end function c

end interface

end interface

interface

interface

   function d()

   function d()

     complex, pointer :: d

     complex, pointer :: d

   end function d

   end function d

end interface

end interface

interface

interface

   function e () result(r)

   function e () result(r)

     complex, pointer :: r

     complex, pointer :: r

   end function e

   end function e

end interface

end interface

interface

interface

   function f () result(r)

   function f () result(r)

     complex, pointer :: r

     complex, pointer :: r

   end function f

   end function f

end interface

end interface

common // z

common // z

complex, target :: z

complex, target :: z

complex, pointer :: p

complex, pointer :: p

z = (1.,0.)

z = (1.,0.)

p => c()

p => c()

z = (2.,0.)

z = (2.,0.)

if (p /= z) call abort ()

if (p /= z) call abort ()

NULLIFY(p)

NULLIFY(p)

p => d()

p => d()

z = (3.,0.)

z = (3.,0.)

if (p /= z) call abort ()

if (p /= z) call abort ()

NULLIFY(p)

NULLIFY(p)

p => e()

p => e()

z = (4.,0.)

z = (4.,0.)

if (p /= z) call abort ()

if (p /= z) call abort ()

NULLIFY(p)

NULLIFY(p)

p => f()

p => f()

z = (5.,0.)

z = (5.,0.)

if (p /= z) call abort ()

if (p /= z) call abort ()

end

end