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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94412 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc5f01e..94a1639 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 7ce9da6..a63112b 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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,

diff --git a/gcc/testsuite/gfortran.dg/double_complex_1.f90 b/gcc/testsuite/gfortran.dg/double_complex_1.f90
new file mode 100644 (file)
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
+