From 985aff9c177850b75e1684d42eaeaef06f86318b Mon Sep 17 00:00:00 2001 From: Paul Brook Date: Sat, 29 Jan 2005 17:46:34 +0000 Subject: [PATCH] re PR fortran/18565 (gfortran: CONJG: false error message about standard violation) 2005-01-29 Paul Brook PR fortran/18565 * check.c (real_or_complex_check): New function. (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): New functions. * intrinsic.c (add_functions): Use new check functions. * intrinsic.h (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): Add prototypes. testsuite/ * gfortran.dg/double_complex_1.f90: New test. From-SVN: r94412 --- gcc/fortran/ChangeLog | 9 +++++ gcc/fortran/check.c | 51 ++++++++++++++++++++++++++ gcc/fortran/intrinsic.c | 32 ++++++++-------- gcc/fortran/intrinsic.h | 3 ++ gcc/testsuite/ChangeLog | 9 +++++ gcc/testsuite/gfortran.dg/double_complex_1.f90 | 18 +++++++++ 6 files changed, 106 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/double_complex_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dc5f01e..94a1639 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-01-29 Paul Brook + + PR fortran/18565 + * check.c (real_or_complex_check): New function. + (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): New functions. + * intrinsic.c (add_functions): Use new check functions. + * intrinsic.h (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): + Add prototypes. + 2005-01-29 Steven G. Kargl PR fortran/19589 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 7ce9da6..a63112b 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -88,6 +88,21 @@ int_or_real_check (gfc_expr * e, int n) } +/* Check that an expression is real or complex. */ + +static try +real_or_complex_check (gfc_expr * e, int n) +{ + if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX) + { + must_be (e, n, "REAL or COMPLEX"); + return FAILURE; + } + + return SUCCESS; +} + + /* Check that the expression is an optional constant integer and that it specifies a valid kind for that type. */ @@ -718,6 +733,42 @@ gfc_check_eoshift (gfc_expr * array, gfc_expr * shift, gfc_expr * boundary, } +/* A single complex argument. */ + +try +gfc_check_fn_c (gfc_expr * a) +{ + if (type_check (a, 0, BT_COMPLEX) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +/* A single real argument. */ + +try +gfc_check_fn_r (gfc_expr * a) +{ + if (type_check (a, 0, BT_REAL) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +/* A single real or complex argument. */ + +try +gfc_check_fn_rc (gfc_expr * a) +{ + if (real_or_complex_check (a, 0) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + try gfc_check_fnum (gfc_expr * unit) { diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 4055d8b..03d443f 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -900,7 +900,7 @@ add_functions (void) make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95); add_sym_1 ("acos", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_acos, gfc_resolve_acos, + gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dacos", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -922,7 +922,7 @@ add_functions (void) make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95); add_sym_1 ("aimag", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_aimag, gfc_resolve_aimag, + gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag, z, BT_COMPLEX, dz, REQUIRED); add_sym_1 ("dimag", 1, 1, BT_REAL, dd, GFC_STD_GNU, @@ -970,7 +970,7 @@ add_functions (void) make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95); add_sym_1 ("asin", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_asin, gfc_resolve_asin, + gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dasin", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -986,7 +986,7 @@ add_functions (void) make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95); add_sym_1 ("atan", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_atan, gfc_resolve_atan, + gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan, x, BT_REAL, dr, REQUIRED); add_sym_1 ("datan", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1107,7 +1107,7 @@ add_functions (void) make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU); add_sym_1 ("conjg", 1, 1, BT_COMPLEX, dz, GFC_STD_F77, - NULL, gfc_simplify_conjg, gfc_resolve_conjg, + gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg, z, BT_COMPLEX, dz, REQUIRED); add_sym_1 ("dconjg", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU, @@ -1117,11 +1117,11 @@ add_functions (void) make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77); add_sym_1 ("cos", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_cos, gfc_resolve_cos, + gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dcos", 1, 1, BT_REAL, dd, GFC_STD_F77, - NULL, gfc_simplify_cos, gfc_resolve_cos, + gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos, x, BT_REAL, dd, REQUIRED); add_sym_1 ("ccos", 1, 1, BT_COMPLEX, dz, GFC_STD_F77, @@ -1137,7 +1137,7 @@ add_functions (void) make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77); add_sym_1 ("cosh", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_cosh, gfc_resolve_cosh, + gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dcosh", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1249,7 +1249,7 @@ add_functions (void) make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU); add_sym_1 ("exp", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_exp, gfc_resolve_exp, + gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dexp", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1477,7 +1477,7 @@ add_functions (void) make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77); add_sym_1 ("log", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_log, gfc_resolve_log, + gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log, x, BT_REAL, dr, REQUIRED); add_sym_1 ("alog", 1, 1, BT_REAL, dr, GFC_STD_F77, @@ -1501,7 +1501,7 @@ add_functions (void) make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77); add_sym_1 ("log10", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_log10, gfc_resolve_log10, + gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10, x, BT_REAL, dr, REQUIRED); add_sym_1 ("alog10", 1, 1, BT_REAL, dr, GFC_STD_F77, @@ -1821,7 +1821,7 @@ add_functions (void) make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77); add_sym_1 ("sin", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_sin, gfc_resolve_sin, + gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dsin", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1841,7 +1841,7 @@ add_functions (void) make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77); add_sym_1 ("sinh", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_sinh, gfc_resolve_sinh, + gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dsinh", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1870,7 +1870,7 @@ add_functions (void) make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95); add_sym_1 ("sqrt", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_sqrt, gfc_resolve_sqrt, + gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dsqrt", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1909,7 +1909,7 @@ add_functions (void) make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU); add_sym_1 ("tan", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_tan, gfc_resolve_tan, + gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dtan", 1, 1, BT_REAL, dd, GFC_STD_F77, @@ -1919,7 +1919,7 @@ add_functions (void) make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77); add_sym_1 ("tanh", 1, 1, BT_REAL, dr, GFC_STD_F77, - NULL, gfc_simplify_tanh, gfc_resolve_tanh, + gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh, x, BT_REAL, dr, REQUIRED); add_sym_1 ("dtanh", 1, 1, BT_REAL, dd, GFC_STD_F77, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 53369c8..41593ef 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -48,6 +48,9 @@ try gfc_check_dot_product (gfc_expr *, gfc_expr *); try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_etime (gfc_expr *); try gfc_check_fstat (gfc_expr *, gfc_expr *); +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_huge (gfc_expr *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e7ff37e..7f6149c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2005-01-29 Paul Brook + + PR fortran/18565 + * check.c (real_or_complex_check): New function. + (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): New functions. + * intrinsic.c (add_functions): Use new check functions. + * intrinsic.h (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): + Add prototypes. + 2005-01-29 Joseph S. Myers * gcc.dg/Wwrite-strings-1.c, gcc.dg/array-quals-2.c, diff --git a/gcc/testsuite/gfortran.dg/double_complex_1.f90 b/gcc/testsuite/gfortran.dg/double_complex_1.f90 new file mode 100644 index 0000000..fc925a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/double_complex_1.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-options "--std=f95" } +! PR18565 +! As we provide "double complex" versions of certain intrinsics an extension. +! However --std=f95 was also breaking the generic versions, which should work +! on any type kind. +program prog + complex(kind=kind(0d0)) :: c + print *, abs(c) + print *, aimag(c) + print *, conjg(c) + print *, cos(c) + print *, exp(c) + print *, log(c) + print *, sin(c) + print *, sqrt(c) +end program + -- 2.7.4