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]

[patch, fortran] PR 33162 INTRINSIC functions as ACTUAL argument


This patch takes care of the first part of this PR. It adds checks for double precision actual arguments for specific double intrinsic functions.

The patch is self explanatory.

Regression tested on x86-64.

OK for commit?

Jerry

2007-10-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR fortran/33162
	* intrinsic.h: Add prototypes for two new functions, gfc_check_a_pd
	and gfc_check_fn_d.
	* intrinsic.c (add_functions): Add checks for double precision for dabs,
	dacos, dacosh, dasin, dasinh, datan, datanh, datan2, dbesj0, dbesj1,
	dbesy0, dbesy1, dcos, dcosh, ddim, derf, derfc, dexp, dgamma,
	dlgamma, dlog, dlog10, dmod, dsign, dsin, dsinh, dsqrt, dtan, and dtanh.
	Add check for real for dprod.
	* check.c (gfc_check_a_pd): New function to check for double precision
	argumants. (gfc_check_fn_d): Ditto.
Index: intrinsic.h
===================================================================
--- intrinsic.h	(revision 129565)
+++ intrinsic.h	(working copy)
@@ -29,6 +29,7 @@ extern gfc_expr gfc_bad_expr;
 try gfc_check_a_ikind (gfc_expr *, gfc_expr *);
 try gfc_check_a_xkind (gfc_expr *, gfc_expr *);
 try gfc_check_a_p (gfc_expr *, gfc_expr *);
+try gfc_check_a_pd (gfc_expr *, gfc_expr *);
 
 try gfc_check_abs (gfc_expr *);
 try gfc_check_access_func (gfc_expr *, gfc_expr *);
@@ -58,6 +59,7 @@ try gfc_check_fgetput (gfc_expr *);
 try gfc_check_fstat (gfc_expr *, gfc_expr *);
 try gfc_check_ftell (gfc_expr *);
 try gfc_check_fn_c (gfc_expr *);
+try gfc_check_fn_d (gfc_expr *);
 try gfc_check_fn_r (gfc_expr *);
 try gfc_check_fn_rc (gfc_expr *);
 try gfc_check_fnum (gfc_expr *);
Index: intrinsic.c
===================================================================
--- intrinsic.c	(revision 129565)
+++ intrinsic.c	(working copy)
@@ -923,7 +923,7 @@ add_functions (void)
 	     a, BT_INTEGER, di, REQUIRED);
 
   add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_abs, gfc_resolve_abs,
+	     gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
 	     a, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
@@ -958,7 +958,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_acos, gfc_resolve_acos,
+	     gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
@@ -968,7 +968,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
-	     NULL, gfc_simplify_acosh, gfc_resolve_acosh,
+	     gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU);
@@ -1041,7 +1041,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_asin, gfc_resolve_asin,
+	     gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
@@ -1051,7 +1051,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
-	     NULL, gfc_simplify_asinh, gfc_resolve_asinh,
+	     gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU);
@@ -1067,7 +1067,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_atan, gfc_resolve_atan,
+	     gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
@@ -1077,7 +1077,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
-	     NULL, gfc_simplify_atanh, gfc_resolve_atanh,
+	     gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU);
@@ -1087,7 +1087,7 @@ add_functions (void)
 	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
 
   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_atan2, gfc_resolve_atan2,
+	     gfc_check_a_pd, gfc_simplify_atan2, gfc_resolve_atan2,
 	     y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
 
   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
@@ -1098,7 +1098,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
@@ -1108,7 +1108,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
@@ -1128,7 +1128,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
@@ -1138,7 +1138,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
@@ -1232,7 +1232,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
+	     gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
 	     x, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
@@ -1252,7 +1252,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_cosh, gfc_resolve_cosh,
+	     gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
@@ -1301,7 +1301,7 @@ add_functions (void)
 	     x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
 
   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_dim, gfc_resolve_dim,
+	     gfc_check_a_pd, gfc_simplify_dim, gfc_resolve_dim,
 	     x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
 
   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
@@ -1313,7 +1313,7 @@ add_functions (void)
   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
 
   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_dprod, gfc_resolve_dprod,
+	     gfc_check_a_p, gfc_simplify_dprod, gfc_resolve_dprod,
 	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
 
   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
@@ -1343,7 +1343,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
@@ -1353,7 +1353,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
-	     gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
+	     gfc_check_fn_d, NULL, gfc_resolve_g77_math1,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
@@ -1372,7 +1372,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_exp, gfc_resolve_exp,
+	     gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
 	     x, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
@@ -1458,7 +1458,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dgamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
-	     gfc_check_fn_r, gfc_simplify_gamma, gfc_resolve_gamma,
+	     gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
 	     x, BT_REAL, dr, REQUIRED);
 
   make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_GNU);
@@ -1721,7 +1721,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
-	     gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
+	     gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
 	     x, BT_REAL, dr, REQUIRED);
 
   make_generic ("lgamma", GFC_ISYM_LGAMMA, GFC_STD_GNU);
@@ -1766,7 +1766,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_log, gfc_resolve_log,
+	     gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
 	     x, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
@@ -1790,7 +1790,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_log10, gfc_resolve_log10,
+	     gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
@@ -1943,7 +1943,7 @@ add_functions (void)
 	     a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
 
   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_mod, gfc_resolve_mod,
+	     gfc_check_a_pd, gfc_simplify_mod, gfc_resolve_mod,
 	     a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
 
   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
@@ -2143,7 +2143,7 @@ add_functions (void)
 	     a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
 
   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_sign, gfc_resolve_sign,
+	     gfc_check_a_pd, gfc_simplify_sign, gfc_resolve_sign,
 	     a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
 
   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
@@ -2159,7 +2159,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_sin, gfc_resolve_sin,
+	     gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
 	     x, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
@@ -2179,7 +2179,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_sinh, gfc_resolve_sinh,
+	     gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
@@ -2216,7 +2216,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
+	     gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
 	     x, BT_REAL, dd, REQUIRED);
 
   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
@@ -2261,7 +2261,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_tan, gfc_resolve_tan,
+	     gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
@@ -2271,7 +2271,7 @@ add_functions (void)
 	     x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
-	     NULL, gfc_simplify_tanh, gfc_resolve_tanh,
+	     gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
Index: check.c
===================================================================
--- check.c	(revision 129565)
+++ check.c	(working copy)
@@ -575,6 +575,16 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
 
 
 try
+gfc_check_a_pd (gfc_expr *a, gfc_expr *p)
+{
+  if (double_check (a, 0) == FAILURE || double_check (p, 0) == FAILURE)
+    return FAILURE;
+
+  return gfc_check_a_p (a, p);
+}
+
+
+try
 gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 {
   symbol_attribute attr;
@@ -1026,6 +1036,16 @@ gfc_check_fn_r (gfc_expr *a)
   return SUCCESS;
 }
 
+/* A single double argument.  */
+
+try
+gfc_check_fn_d (gfc_expr *a)
+{
+  if (double_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
 
 /* A single real or complex argument.  */
 

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