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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94412
138bc75d-0d04-0410-961f-
82ee72b054a4
+2005-01-29 Paul Brook <paul@codesourcery.com>
+
+ 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 <kargls@comcast.net>
PR fortran/19589
2005-01-29 Steven G. Kargl <kargls@comcast.net>
PR fortran/19589
+/* 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. */
/* Check that the expression is an optional constant integer
and that it specifies a valid kind for that type. */
+/* 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)
{
try
gfc_check_fnum (gfc_expr * unit)
{
make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
add_sym_1 ("acos", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dacos", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
add_sym_1 ("aimag", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
z, BT_COMPLEX, dz, REQUIRED);
add_sym_1 ("dimag", 1, 1, BT_REAL, dd, GFC_STD_GNU,
make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
add_sym_1 ("asin", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dasin", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
add_sym_1 ("atan", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("datan", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
add_sym_1 ("conjg", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
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,
z, BT_COMPLEX, dz, REQUIRED);
add_sym_1 ("dconjg", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU,
make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
add_sym_1 ("cos", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
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,
x, BT_REAL, dd, REQUIRED);
add_sym_1 ("ccos", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
add_sym_1 ("cosh", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dcosh", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
add_sym_1 ("exp", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dexp", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
add_sym_1 ("log", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("alog", 1, 1, BT_REAL, dr, GFC_STD_F77,
make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
add_sym_1 ("log10", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("alog10", 1, 1, BT_REAL, dr, GFC_STD_F77,
make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
add_sym_1 ("sin", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dsin", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
add_sym_1 ("sinh", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dsinh", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
add_sym_1 ("sqrt", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dsqrt", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
add_sym_1 ("tan", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dtan", 1, 1, BT_REAL, dd, GFC_STD_F77,
make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
add_sym_1 ("tanh", 1, 1, BT_REAL, dr, GFC_STD_F77,
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,
x, BT_REAL, dr, REQUIRED);
add_sym_1 ("dtanh", 1, 1, BT_REAL, dd, GFC_STD_F77,
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_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 *);
try gfc_check_fnum (gfc_expr *);
try gfc_check_g77_math1 (gfc_expr *);
try gfc_check_huge (gfc_expr *);
+2005-01-29 Paul Brook <paul@codesourcery.com>
+
+ 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 <joseph@codesourcery.com>
* gcc.dg/Wwrite-strings-1.c, gcc.dg/array-quals-2.c,
2005-01-29 Joseph S. Myers <joseph@codesourcery.com>
* gcc.dg/Wwrite-strings-1.c, gcc.dg/array-quals-2.c,
--- /dev/null
+! { 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
+