re PR fortran/33162 (INTRINSIC functions as ACTUAL argument)

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

	PR fortran/33162
	* intrinsic.h: Add prototypes for four new functions, gfc_check_datan2,
	gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd.
	* intrinsic.c (add_functions): Add double precision checks for dabs,
	dacos, dacosh, dasin, dasinh, datan, datanh, datan2, dbesj0, dbesj1,
	dbesy0, dbesy1, dcos, dcosh, ddim, derf, derfc, dexp, dgamma,
	dlgama, dlog, dlog10, dmod, dsign, dsin, dsinh, dsqrt, dtan, and dtanh.
	Add real check dprod.
	* check.c (gfc_check_datan2): New function to check for double precision
	argumants. (gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd): Ditto.

From-SVN: r129673

gcc/fortran/ChangeLog

 2007-10-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
+	PR fortran/33162
+	* intrinsic.h: Add prototypes for four new functions, gfc_check_datan2,
+	gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd.
+	* intrinsic.c (add_functions): Add double precision checks for dabs,
+	dacos, dacosh, dasin, dasinh, datan, datanh, datan2, dbesj0, dbesj1,
+	dbesy0, dbesy1, dcos, dcosh, ddim, derf, derfc, dexp, dgamma,
+	dlgama, dlog, dlog10, dmod, dsign, dsin, dsinh, dsqrt, dtan, and dtanh.
+	Add real check dprod.
+	* check.c (gfc_check_datan2): New function to check for double precision
+	argumants. (gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd): Ditto.
+
+2007-10-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
 	* invoke.texi: Fix typo in -fmax-errors=.
 
 2007-10-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

gcc/fortran/check.c

@@ -575,6 +575,16 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
 
 
 try
+gfc_check_x_yd (gfc_expr *x, gfc_expr *y)
+{
+  if (double_check (x, 0) == FAILURE || double_check (y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 {
   symbol_attribute attr;
@@ -881,6 +891,14 @@ gfc_check_ctime (gfc_expr *time)
 }
 
 
+try gfc_check_datan2 (gfc_expr *y, gfc_expr *x)
+{
+  if (double_check (y, 0) == FAILURE || double_check (x, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
 try
 gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 {
@@ -968,6 +986,33 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
 
 
 try
+gfc_check_dprod (gfc_expr *x, gfc_expr *y)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE
+      || type_check (y, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (x->ts.kind != gfc_default_real_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+		 "real", gfc_current_intrinsic_arg[0],
+		 gfc_current_intrinsic, &x->where);
+      return FAILURE;
+    }
+
+  if (y->ts.kind != gfc_default_real_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+		 "real", gfc_current_intrinsic_arg[1],
+		 gfc_current_intrinsic, &y->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 		   gfc_expr *dim)
 {
@@ -1026,6 +1071,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.  */
 

gcc/fortran/intrinsic.h

@@ -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_x_yd (gfc_expr *, gfc_expr *);
 
 try gfc_check_abs (gfc_expr *);
 try gfc_check_access_func (gfc_expr *, gfc_expr *);
@@ -47,10 +48,12 @@ try gfc_check_complex (gfc_expr *, gfc_expr *);
 try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_ctime (gfc_expr *);
+try gfc_check_datan2 (gfc_expr *, gfc_expr *);
 try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
 try gfc_check_dble (gfc_expr *);
 try gfc_check_digits (gfc_expr *);
 try gfc_check_dot_product (gfc_expr *, gfc_expr *);
+try gfc_check_dprod (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_fgetputc (gfc_expr *, gfc_expr *);
@@ -58,6 +61,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 *);