OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/18565 (gfortran: CONJG: false error message about standard violation) 

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.
testsuite/
	* gfortran.dg/double_complex_1.f90: New test.

From-SVN: r94412
This commit is contained in:
Paul Brook 2005-01-29 17:46:34 +00:00 committed by Paul Brook
parent 46df282378
commit 985aff9c17
6 changed files with 106 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
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

51
gcc/fortran/check.c
View File

@ -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)
{

32
gcc/fortran/intrinsic.c
View File

@ -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,

3
gcc/fortran/intrinsic.h
View File

@ -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 *);

9
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,12 @@
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,

18
gcc/testsuite/gfortran.dg/double_complex_1.f90 Normal file
View File

@ -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