aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/check.c
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2010-08-19 09:28:17 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2010-08-19 09:28:17 +0200
commit29698e0f2fa1c77242782bc5c8c6a9327b8d32cf (patch)
tree444e1c1a219a8b1f5c18e7b23532f2e12dbfa224 /gcc/fortran/check.c
parent771c5727a06b8d64ce037f592737108ce5fd93e9 (diff)
downloadgcc-29698e0f2fa1c77242782bc5c8c6a9327b8d32cf.zip
gcc-29698e0f2fa1c77242782bc5c8c6a9327b8d32cf.tar.gz
gcc-29698e0f2fa1c77242782bc5c8c6a9327b8d32cf.tar.bz2
re PR fortran/36158 (Transformational function BESSEL_YN(n1,n2,x) and BESSEL_JN missing)
2010-08-19 Tobias Burnus <burnus@net-b.de> PR fortran/36158 PR fortran/33197 * check.c (gfc_check_bessel_n2): New function. * gfortran.h (gfc_isym_id): Add GFC_ISYM_JN2 and GFC_ISYM_YN2. * intrinsic.c (add_functions): Add transformational version of the Bessel_jn/yn intrinsics. * intrinsic.h (gfc_check_bessel_n2,gfc_simplify_bessel_jn2, gfc_simplify_bessel_yn2): New prototypes. * intrinsic.texi (Bessel_jn, Bessel_yn): Document transformational variant. * simplify.c (gfc_simplify_bessel_jn, gfc_simplify_bessel_yn): Check for negative order. (gfc_simplify_bessel_n2,gfc_simplify_bessel_jn2, gfc_simplify_bessel_yn2): New functions. 2010-08-19 Tobias Burnus <burnus@net-b.de> PR fortran/36158 PR fortran/33197 * gfortran.dg/bessel_3.f90: New. * gfortran.dg/bessel_4.f90: New. * gfortran.dg/bessel_5.f90: New. From-SVN: r163364
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r--gcc/fortran/check.c36
1 files changed, 36 insertions, 0 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ad040f1..36efffa 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -884,6 +884,14 @@ gfc_check_besn (gfc_expr *n, gfc_expr *x)
{
if (type_check (n, 0, BT_INTEGER) == FAILURE)
return FAILURE;
+ if (n->expr_type == EXPR_CONSTANT)
+ {
+ int i;
+ gfc_extract_int (n, &i);
+ if (i < 0 && gfc_notify_std (GFC_STD_GNU, "Extension: Negative argument "
+ "N at %L", &n->where) == FAILURE)
+ return FAILURE;
+ }
if (type_check (x, 1, BT_REAL) == FAILURE)
return FAILURE;
@@ -892,6 +900,34 @@ gfc_check_besn (gfc_expr *n, gfc_expr *x)
}
+/* Transformational version of the Bessel JN and YN functions. */
+
+gfc_try
+gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
+{
+ if (type_check (n1, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+ if (scalar_check (n1, 0) == FAILURE)
+ return FAILURE;
+ if (nonnegative_check("N1", n1) == FAILURE)
+ return FAILURE;
+
+ if (type_check (n2, 1, BT_INTEGER) == FAILURE)
+ return FAILURE;
+ if (scalar_check (n2, 1) == FAILURE)
+ return FAILURE;
+ if (nonnegative_check("N2", n2) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 2, BT_REAL) == FAILURE)
+ return FAILURE;
+ if (scalar_check (x, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
gfc_try
gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
{