mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
84 lines
1.8 KiB
Fortran
84 lines
1.8 KiB
Fortran
! { dg-do run }
|
|
! { dg-additional-sources value_4.c }
|
|
! { dg-options "-ff2c -w -O0" }
|
|
!
|
|
! Tests the functionality of the patch for PR29642, which requested the
|
|
! implementation of the F2003 VALUE attribute for gfortran, by calling
|
|
! external C functions by value and by reference. This is effectively
|
|
! identical to c_by_val_1.f, which does the same for %VAL.
|
|
!
|
|
! Contributed by Paul Thomas <pault@gcc.gnu.org>
|
|
!
|
|
module global
|
|
interface delta
|
|
module procedure deltai, deltar, deltac
|
|
end interface delta
|
|
real(4) :: epsi = epsilon (1.0_4)
|
|
contains
|
|
function deltai (a, b) result (c)
|
|
integer(4) :: a, b
|
|
logical :: c
|
|
c = (a /= b)
|
|
end function deltai
|
|
|
|
function deltar (a, b) result (c)
|
|
real(4) :: a, b
|
|
logical :: c
|
|
c = (abs (a-b) > epsi)
|
|
end function deltar
|
|
|
|
function deltac (a, b) result (c)
|
|
complex(4) :: a, b
|
|
logical :: c
|
|
c = ((abs (real (a-b)) > epsi).or.(abs (aimag (a-b)) > epsi))
|
|
end function deltac
|
|
end module global
|
|
|
|
program value_4
|
|
use global
|
|
interface
|
|
function f_to_f (x, y)
|
|
real(4), pointer :: f_to_f
|
|
real(4) :: x, y
|
|
value :: x
|
|
end function f_to_f
|
|
end interface
|
|
|
|
interface
|
|
function i_to_i (x, y)
|
|
integer(4), pointer :: i_to_i
|
|
integer(4) :: x, y
|
|
value :: x
|
|
end function i_to_i
|
|
end interface
|
|
|
|
interface
|
|
complex(4) function c_to_c (x, y)
|
|
complex(4) :: x, y
|
|
value :: x
|
|
end function c_to_c
|
|
end interface
|
|
|
|
real(4) a, b, c
|
|
integer(4) i, j, k
|
|
complex(4) u, v, w
|
|
|
|
a = 42.0
|
|
b = 0.0
|
|
c = a
|
|
b = f_to_f (a, c)
|
|
if (delta ((2.0 * a), b)) STOP 1
|
|
|
|
i = 99
|
|
j = 0
|
|
k = i
|
|
j = i_to_i (i, k)
|
|
if (delta ((3_4 * i), j)) STOP 2
|
|
|
|
u = (-1.0, 2.0)
|
|
v = (1.0, -2.0)
|
|
w = u
|
|
v = c_to_c (u, w)
|
|
if (delta ((4.0 * u), v)) STOP 3
|
|
end program value_4
|