This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [gfortran] Fix PR 18565


On Thursday 27 January 2005 21:50, Steve Kargl wrote:
> 2005-01-27  Steven G. Kargl  <kargls@comcast.net>
>
>       PR 18565
>       * intrinsic.c (add_function): Permit complex(8) version for generic
>       names without corresponding specific names.

No. Your fix is just papering over the underlying problem.
We should allow any complex type for the generic forms of these intrinsics 
(eg. the not-very-well-implemented kind=10 in x86 targets).

You'll notice that abs already works properly because we DTRT in 
gfc_check_abs.

Fixed by adding check functions for a bunch of intrinsics that didn't have 
them previously.

Tested on i686-linux.
Applied to mainline.

Paul

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.
Index: check.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/check.c,v
retrieving revision 1.22
diff -u -p -r1.22 check.c
--- check.c	18 Jan 2005 12:11:45 -0000	1.22
+++ check.c	29 Jan 2005 17:00:22 -0000
@@ -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
 }
 
 
+/* 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)
 {
Index: intrinsic.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.37
diff -u -p -r1.37 intrinsic.c
--- intrinsic.c	22 Jan 2005 22:32:06 -0000	1.37
+++ intrinsic.c	29 Jan 2005 16:58:14 -0000
@@ -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,
Index: intrinsic.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.20
diff -u -p -r1.20 intrinsic.h
--- intrinsic.h	2 Dec 2004 04:10:24 -0000	1.20
+++ intrinsic.h	29 Jan 2005 17:13:14 -0000
@@ -48,6 +48,9 @@ try gfc_check_dot_product (gfc_expr *, g
 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 *);

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]