errors with extended specific.f90

[Dominique Dhumieres]

I have added a few missing real intrinsics and some complex ones
to gcc/testsuite/gfortran.fortran-torture/execute/specifics.f90.
When compiled with gfortran I get:

[karma] bug/failed% gfortran specifics_db.f90 
/sw/lib/odcctools/bin/ld: Undefined symbols:
_specific__aimag_c4
_specific__aimag_c8
_specific__conjg_4
_specific__conjg_8
_specific__dim_u4
collect2: ld returned 1 exit status

In the process I have also learnt that not all intrinsics are born
equal and that some cannot be actual arguments, so I have written
a second program from the original one containing illegal arguments
and I get:

[karma] bug/failed% gfortran specifics_err.f90
specifics_err.f90: In function 'MAIN__':
specifics_err.f90:67: internal compiler error: in gfc_get_extern_function_decl, at fortran/trans-decl.c:925
Please submit a full bug report,
with preprocessed source if appropriate.
See <URL:http://gcc.gnu.org/bugs.html> for instructions.

Unless someone volunteer to do it I can fill bug report(s) (one or
two?), but I'll probably have to ask for an account on bugzilla (yurk!).

Dominique

---------------------------- specifics_db.f90 --------------------------

! Program to test intrinsic functions as actual arguments
subroutine test_r(fn, val, res)
  real fn
  real val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  real a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_rc(fn, val, res)
  real fn
  complex val
  real res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  real a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_d(fn, val, res)
  double precision fn
  double precision val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  double precision a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine

subroutine test_dc(fn, val, res)
  double precision fn
  complex*16 val
  double precision res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  double precision a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine

subroutine test_c(fn, val, res)
  complex fn
  complex val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  complex a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_z(fn, val, res)
  complex*16 fn
  complex*16 val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  complex*16 a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_r2(fn, val1, val2, res)
  real fn
  real val1, val2, res

  if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
  real a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_d2(fn, val1, val2, res)
  double precision fn
  double precision val1, val2, res

  if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
  double precision a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine

subroutine test_dprod(fn)
  double precision fn
  if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
end subroutine

program specifics

  intrinsic abs
  intrinsic aint
  intrinsic anint
  intrinsic sqrt
  intrinsic acos
  intrinsic asin
  intrinsic atan
  intrinsic cos
  intrinsic sin
  intrinsic tan
  intrinsic cosh
  intrinsic sinh
  intrinsic tanh
  intrinsic alog
  intrinsic alog10
  intrinsic exp
  intrinsic atan2
  intrinsic dim
  intrinsic sign
  intrinsic amod

  intrinsic dabs
  intrinsic dint
  intrinsic dnint
  intrinsic dsqrt
  intrinsic dacos
  intrinsic dasin
  intrinsic datan
  intrinsic dcos
  intrinsic dsin
  intrinsic dtan
  intrinsic dcosh
  intrinsic dsinh
  intrinsic dtanh
  intrinsic dlog
  intrinsic dlog10
  intrinsic dexp
  intrinsic datan2
  intrinsic ddim
  intrinsic dsign
  intrinsic dmod

  intrinsic dprod

  intrinsic cabs
  intrinsic aimag
  intrinsic conjg
  intrinsic ccos
  intrinsic cexp
  intrinsic clog
  intrinsic csin
  intrinsic csqrt

  intrinsic zabs
  intrinsic dimag
  intrinsic dconjg
  intrinsic zcos
  intrinsic zexp
  intrinsic zlog
  intrinsic zsin
  intrinsic zsqrt

  call test_r (abs, -1.0, abs(-1.0))
  call test_r (aint, 1.7, 1.0)
  call test_r (anint, 1.7, 2.0)
  call test_r (sqrt, 1.0, sqrt(1.0))
  call test_r (acos, 0.5, acos(0.5))
  call test_r (asin, 0.5, asin(0.5))
  call test_r (atan, 0.5, atan(0.5))
  call test_r (cos, 1.0, cos(1.0))
  call test_r (sin, 1.0, sin(1.0))
  call test_r (tan, 1.0, tan(1.0))
  call test_r (cosh, 1.0, cosh(1.0))
  call test_r (sinh, 1.0, sinh(1.0))
  call test_r (tanh, 1.0, tanh(1.0))
  call test_r (alog, 2.0, alog(2.0))
  call test_r (alog10, 2.0, alog10(2.0))
  call test_r (exp, 1.0, exp(1.0))
  call test_r2 (atan2, 1.0, -2.0, atan2(1.0, -2.0))
  call test_r2 (dim, 1.0, -2.0, dim(1.0, -2.0))
  call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
  call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
  
  call test_d (dabs, -1d0, abs(-1d0))
  call test_d (dint, 1.7d0, 1d0)
  call test_d (dnint, 1.7d0, 2d0)
  call test_d (dsqrt, 1d0, dsqrt(1d0))
  call test_d (dacos, 0.5d0, dacos(0.5d0))
  call test_d (dasin, 0.5d0, dasin(0.5d0))
  call test_d (datan, 0.5d0, datan(0.5d0))
  call test_d (dcos, 1d0, dcos(1d0))
  call test_d (dsin, 1d0, dsin(1d0))
  call test_d (dtan, 1d0, dtan(1d0))
  call test_d (dcosh, 1d0, dcosh(1d0))
  call test_d (dsinh, 1d0, dsinh(1d0))
  call test_d (dtanh, 1d0, dtanh(1d0))
  call test_d (dlog, 2d0, dlog(2d0))
  call test_d (dlog10, 2d0, dlog10(2d0))
  call test_d (dexp, 1d0, dexp(1d0))
  call test_d2 (datan2, 1.0d0, -2.0d0, datan2(1.0d0, -2.0d0))
  call test_d2 (ddim, 1d0, -2d0, dim(1d0, -2d0))
  call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
  call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))

  call test_dprod(dprod)
  
  call test_rc (cabs, (1.0,1.0) , abs((1.0,1.0)))
  call test_rc (aimag, (1.0,1.0) , aimag((1.0,1.0)))
  call test_c (conjg, (1.0,1.0) , conjg((1.0,1.0)))
  call test_c (ccos, (1.0,1.0) , cos((1.0,1.0)))
  call test_c (cexp, (1.0,1.0) , exp((1.0,1.0)))
  call test_c (clog, (1.0,1.0) , log((1.0,1.0)))
  call test_c (csin, (1.0,1.0) , sin((1.0,1.0)))
  call test_c (csqrt, (1.0,1.0) , sqrt((1.0,1.0)))

  call test_dc (zabs, (1.0d0,1.0d0) , abs((1.0d0,1.0d0)))
  call test_dc (dimag, (1.0d0,1.0d0) , aimag((1.0d0,1.0d0)))
  call test_z (dconjg, (1.0d0,1.0d0) , conjg((1.0d0,1.0d0)))
  call test_z (zcos, (1.0d0,1.0d0) , cos((1.0d0,1.0d0)))
  call test_z (zexp, (1.0d0,1.0d0) , exp((1.0d0,1.0d0)))
  call test_z (zlog, (1.0d0,1.0d0) , log((1.0d0,1.0d0)))
  call test_z (zsin, (1.0d0,1.0d0) , sin((1.0d0,1.0d0)))
  call test_z (zsqrt, (1.0d0,1.0d0) , sqrt((1.0d0,1.0d0)))

end program

--------------------------------- specifics_err.f90 -------------------------

! Program to test intrinsic functions that cannot be actual arguments
subroutine test_r(fn, val, res)
  real fn
  real val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  real a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_d(fn, val, res)
  double precision fn
  double precision val, res

  if (diff(fn(val), res)) call abort
contains
function diff(a, b)
  double precision a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine

subroutine test_r2(fn, val1, val2, res)
  real fn
  real val1, val2, res

  if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
  real a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001)
end function
end subroutine

subroutine test_d2(fn, val1, val2, res)
  double precision fn
  double precision val1, val2, res

  if (diff(fn(val1, val2), res)) call abort
contains
function diff(a, b)
  double precision a, b
  logical diff
  diff = (abs(a - b) .gt. 0.00001d0)
end function
end subroutine

program specifics

  
  intrinsic amax1
  intrinsic amin1

  intrinsic dmax1
  intrinsic dmin1

  intrinsic real

  intrinsic dreal

  call test_r2 (amax1, 3.5, 2.0, max(3.5, 2.0))
  call test_r2 (amin1, 3.5, 2.0, min(3.5, 2.0))
  
  call test_d2 (dmax1, 3.5d0, 2.0d0, max(3.5d0, 2.0d0))
  call test_d2 (dmin1, 3.5d0, 2.0d0, min(3.5d0, 2.0d0))

  call test_r (real, (1.0,1.0) , real((1.0,1.0))) 

  call test_d (dreal, (1.0d0,1.0d0) , real((1.0d0,1.0d0))) 

end program