re PR fortran/40727 ([4.4] ICE gfc_simplify_dcmplx(): Bad type when passing BT_COMPLEX to cmplx)

2009-07-18  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/40727
	* fortran/check.c (gfc_check_cmplx, gfc_check_dcmplx): Add check that
	the optional second argument isn't of COMPLEX type.

2009-07-18  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/40727
	* gfortran.dg/intrinsic_cmplx.f90: New test.

From-SVN: r149793

gcc/fortran/ChangeLog

+2009-07-19  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/40727
+	* fortran/check.c (gfc_check_cmplx, gfc_check_dcmplx): Add check that
+	the optional second argument isn't of COMPLEX type.
+
 2009-07-17  Richard Guenther  <rguenther@suse.de>
 
 	PR c/40401

gcc/fortran/check.c

@@ -819,6 +819,15 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 		     gfc_current_intrinsic, &y->where);
 	  return FAILURE;
 	}
+
+      if (y->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+		     "of either REAL or INTEGER", gfc_current_intrinsic_arg[1],
+		     gfc_current_intrinsic, &y->where);
+	  return FAILURE;
+	}
+
     }
 
   if (kind_check (kind, 2, BT_COMPLEX) == FAILURE)
@@ -977,6 +986,14 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 		     gfc_current_intrinsic, &y->where);
 	  return FAILURE;
 	}
+
+      if (y->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+		     "of either REAL or INTEGER", gfc_current_intrinsic_arg[1],
+		     gfc_current_intrinsic, &y->where);
+	  return FAILURE;
+	}
     }
 
   return SUCCESS;

gcc/testsuite/ChangeLog

+2009-07-18  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/40727
+	* gfortran.dg/intrinsic_cmplx.f90: New test.
+
 2009-07-19   Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR libfortran/34670

gcc/testsuite/gfortran.dg/intrinsic_cmplx.f90

+! { dg-do compile }
+! PR fortran/40727
+program test
+  integer, parameter :: sp = kind(1.e0), dp = kind(1.d0)
+  complex(sp) :: s
+  complex(dp) :: d
+  s =  cmplx(0.e0, cmplx(0.e0,0.e0)) ! { dg-error "either REAL or INTEGER" }
+  d = dcmplx(0.d0, cmplx(0.d0,0.d0)) ! { dg-error "either REAL or INTEGER" }
+end program test