procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/31760 (missing elemental applicability)

Browse source 
gcc/fortran:
2007-05-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31760
        * intrinsic.c (add_functions): Replaced calls to gfc_check_g77_math1
        by gfc_check_fn_r to avoid checks for scalarity.
        * check.c (gfc_check_besn): Removed check for scalarity.
        (gfc_check_g77_math1): Removed.
        * intrinsic.h (gfc_check_g77_math1): Removed.

gcc/testsuite:
2007-05-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31760
        * gfortran.dg/erf.f90: New test.
        * gfortran.dg/besxy.f90: New test.


[gcc/fortran/ChangeLog was already committed in r124441 by accident]

From-SVN: r124446
This commit is contained in:
Daniel Franke 2007-05-04 15:24:43 -04:00 • committed by Daniel Franke
parent f1028b0230
commit 640afd95c0
6 changed files with 55 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
gcc/fortran/check.c
View file

@ -655,9 +655,6 @@ gfc_check_besn (gfc_expr *n, gfc_expr *x)
if (type_check (n, 0, BT_INTEGER) == FAILURE)
return FAILURE;
if (scalar_check (x, 1) == FAILURE)
return FAILURE;
if (type_check (x, 1, BT_REAL) == FAILURE)
return FAILURE;
@ -1037,22 +1034,6 @@ gfc_check_fnum (gfc_expr *unit)
}
/* This is used for the g77 one-argument Bessel functions, and the
error function. */
try
gfc_check_g77_math1 (gfc_expr *x)
{
if (scalar_check (x, 0) == FAILURE)
return FAILURE;
if (type_check (x, 0, BT_REAL) == FAILURE)
return FAILURE;
return SUCCESS;
}
try
gfc_check_huge (gfc_expr *x)
{

24
gcc/fortran/intrinsic.c
View file

@ -1097,21 +1097,21 @@ add_functions (void)
/* Bessel and Neumann functions for G77 compatibility. */
add_sym_1 ("besj0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dbesj0", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
add_sym_1 ("besj1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dbesj1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
@ -1127,21 +1127,21 @@ add_functions (void)
make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU);
add_sym_1 ("besy0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dbesy0", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
add_sym_1 ("besy1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dbesy1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
@ -1340,21 +1340,21 @@ add_functions (void)
/* G77 compatibility for the ERF() and ERFC() functions. */
add_sym_1 ("erf", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("derf", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
add_sym_1 ("erfc", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("derfc", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
x, BT_REAL, dd, REQUIRED);
make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);

1
gcc/fortran/intrinsic.h
View file

@ -62,7 +62,6 @@ try gfc_check_fn_c (gfc_expr *);
try gfc_check_fn_r (gfc_expr *);
try gfc_check_fn_rc (gfc_expr *);
try gfc_check_fnum (gfc_expr *);
try gfc_check_g77_math1 (gfc_expr *);
try gfc_check_hostnm (gfc_expr *);
try gfc_check_huge (gfc_expr *);
try gfc_check_i (gfc_expr *);

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2007-05-04 Daniel Franke <franke.daniel@gmail.com>
PR fortran/31760
* gfortran.dg/erf.f90: New test.
* gfortran.dg/besxy.f90: New test.
2007-05-04 Daniel Franke <franke.daniel@gmail.com>
PR fortran/22359

24
gcc/testsuite/gfortran.dg/besxy.f90 Normal file
View file

@ -0,0 +1,24 @@
! { dg-do compile }
!
! Check whether BESXY functions take scalars and
! arrays as arguments (PR31760).
!
PROGRAM test_erf
REAL :: r = 0.0, ra(2) = (/ 0.0, 1.0 /)
r = BESJ0(r)
r = BESJ1(r)
r = BESJN(0, r)
r = BESY0(r)
r = BESY1(r)
r = BESYN(0, r)
ra = BESJ0(ra)
ra = BESJ1(ra)
ra = BESJN(0, ra)
ra = BESY0(ra)
ra = BESY1(ra)
ra = BESYN(0, ra)
END PROGRAM

13
gcc/testsuite/gfortran.dg/erf.f90 Normal file
View file

@ -0,0 +1,13 @@
! { dg-do compile }
!
! Check whether ERF/ERFC take scalars and arrays as arguments (PR31760).
!
PROGRAM test_erf
REAL :: r = 0.0, ra(2) = (/ 0.0, 1.0 /)
r = erf(r)
r = erfc(r)
ra = erf(ra)
ra = erfc(ra)
END PROGRAM