gcc/testsuite/gfortran.dg/f2c_6.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ff2c" }
   3 ! Verifies that complex pointer results work with -ff2c
   4 ! try all permutations of result clause in function yes/no
   5 !                     and result clause in interface yes/no
   6 ! this is not possible in Fortran 77, but this exercises a previously
   7 ! buggy codepath
   8 function c() result (r)
   9   common // z
  10   complex, pointer :: r
  11   complex, target :: z
  12
  13   r=>z
  14 end function c
  15
  16 function d()
  17   common // z
  18   complex, pointer :: d
  19   complex, target :: z
  20
  21   d=>z
  22 end function d
  23
  24 function e()
  25   common // z
  26   complex, pointer :: e
  27   complex, target :: z
  28
  29   e=>z
  30 end function e
  31
  32 function f() result(r)
  33   common // z
  34   complex, pointer :: r
  35   complex, target :: z
  36
  37   r=>z
  38 end function f
  39
  40 interface
  41    function c ()
  42      complex, pointer :: c
  43    end function c
  44 end interface
  45 interface
  46    function d()
  47      complex, pointer :: d
  48    end function d
  49 end interface
  50 interface
  51    function e () result(r)
  52      complex, pointer :: r
  53    end function e
  54 end interface
  55 interface
  56    function f () result(r)
  57      complex, pointer :: r
  58    end function f
  59 end interface
  60
  61 common // z
  62 complex, target :: z
  63 complex, pointer :: p
  64
  65 z = (1.,0.)
  66 p => c()
  67 z = (2.,0.)
  68 if (p /= z) call abort ()
  69
  70 NULLIFY(p)
  71 p => d()
  72 z = (3.,0.)
  73 if (p /= z) call abort ()
  74
  75 NULLIFY(p)
  76 p => e()
  77 z = (4.,0.)
  78 if (p /= z) call abort ()
  79
  80 NULLIFY(p)
  81 p => f()
  82 z = (5.,0.)
  83 if (p /= z) call abort ()
  84 end