Merged trunk at revision 161680 into branch.vect256

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

1 files changed, 67 insertions, 57 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index a92b5b54519..833fd30beb1 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1354,7 +1354,7 @@ add_functions (void)
   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
 
   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
-	     gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
+	     gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
@@ -1738,7 +1738,7 @@ add_functions (void)
   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
 
   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
+	     gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
@@ -1751,7 +1751,7 @@ add_functions (void)
   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
 
   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
-	     gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
+	     gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
 
   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
@@ -2375,10 +2375,11 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
-  add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
+  add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_F95, gfc_check_selected_real_kind,
 	     gfc_simplify_selected_real_kind, NULL,
-	     p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
+	     p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
+	     "radix", BT_INTEGER, di, OPTIONAL);
 
   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
 
@@ -4022,58 +4023,67 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
     }
   else if (wflag)
     {
-      /* Two modes of warning:
-	  - gfc_option.warn_conversion tries to be more intelligent
-	    about the warnings raised and omits those where smaller
-	    kinds are promoted to larger ones without change in the
-	    value
-	  - gfc_option.warn_conversion_extra does not take the kinds
-	    into account and also warns for coversions like
-	    REAL(4) -> REAL(8)
-
-	 NOTE: Possible enhancement for warn_conversion
-	 If converting from a smaller to a larger kind, check if the
-	 value is constant and if yes, whether the value still fits
-	 in the smaller kind. If yes, omit the warning.
-      */
-
-      /* If the types are the same (but not LOGICAL), and if from-kind
-	 is larger than to-kind, this may indicate a loss of precision.
-	 The same holds for conversions from REAL to COMPLEX.  */
-      if (((from_ts.type == ts->type && from_ts.type != BT_LOGICAL)
-           && ((gfc_option.warn_conversion && from_ts.kind > ts->kind)
-	       || gfc_option.warn_conversion_extra))
-	  || ((from_ts.type == BT_REAL && ts->type == BT_COMPLEX)
-	      && ((gfc_option.warn_conversion && from_ts.kind > ts->kind)
-		  || gfc_option.warn_conversion_extra)))
-	gfc_warning_now ("Possible change of value in conversion "
-			 "from %s to %s at %L", gfc_typename (&from_ts),
-			 gfc_typename (ts), &expr->where);
-
-      /* If INTEGER is converted to REAL/COMPLEX, this is generally ok if
-	 the kind of the INTEGER value is less or equal to the kind of the
-	 REAL/COMPLEX one. Otherwise the value may not fit.
-	 Assignment of an overly large integer constant also generates
-	 an overflow error with range checking. */
-      else if (from_ts.type == BT_INTEGER
-	       && (ts->type == BT_REAL || ts->type == BT_COMPLEX)
-	       && ((gfc_option.warn_conversion && from_ts.kind > ts->kind)
-		   || gfc_option.warn_conversion_extra))
-	gfc_warning_now ("Possible change of value in conversion "
-			 "from %s to %s at %L", gfc_typename (&from_ts),
-			 gfc_typename (ts), &expr->where);
-
-      /* If REAL/COMPLEX is converted to INTEGER, or COMPLEX is converted
-        to REAL we almost certainly have a loss of digits, regardless of
-        the respective kinds.  */
-      else if ((((from_ts.type == BT_REAL || from_ts.type == BT_COMPLEX)
-		  && ts->type == BT_INTEGER)
-		|| (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
-	       && (gfc_option.warn_conversion
-	           || gfc_option.warn_conversion_extra))
-	gfc_warning_now ("Possible change of value in conversion from "
-			"%s to %s at %L", gfc_typename (&from_ts),
-			gfc_typename (ts), &expr->where);
+      if (gfc_option.flag_range_check
+	  && expr->expr_type == EXPR_CONSTANT
+	  && from_ts.type == ts->type)
+	{
+	  /* Do nothing. Constants of the same type are range-checked
+	     elsewhere. If a value too large for the target type is
+	     assigned, an error is generated. Not checking here avoids
+	     duplications of warnings/errors.
+	     If range checking was disabled, but -Wconversion enabled,
+	     a non range checked warning is generated below.  */
+	}
+      else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+	{
+	  /* Do nothing. This block exists only to simplify the other
+	     else-if expressions.
+	       LOGICAL <> LOGICAL    no warning, independent of kind values
+	       LOGICAL <> INTEGER    extension, warned elsewhere
+	       LOGICAL <> REAL       invalid, error generated elsewhere
+	       LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
+	}
+      else if (from_ts.type == ts->type
+	       || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
+	       || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
+	       || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
+	{
+	  /* Larger kinds can hold values of smaller kinds without problems.
+	     Hence, only warn if target kind is smaller than the source
+	     kind - or if -Wconversion-extra is specified.  */
+	  if (gfc_option.warn_conversion_extra)
+	    gfc_warning_now ("Conversion from %s to %s at %L",
+			     gfc_typename (&from_ts), gfc_typename (ts),
+			     &expr->where);
+	  else if (gfc_option.warn_conversion
+		   && from_ts.kind > ts->kind)
+	    gfc_warning_now ("Possible change of value in conversion "
+			     "from %s to %s at %L", gfc_typename (&from_ts),
+			     gfc_typename (ts), &expr->where);
+	}
+      else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
+	       || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
+	       || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
+	{
+	  /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
+	     usually comes with a loss of information, regardless of kinds.  */
+	  if (gfc_option.warn_conversion_extra
+	      || gfc_option.warn_conversion)
+	    gfc_warning_now ("Possible change of value in conversion "
+			     "from %s to %s at %L", gfc_typename (&from_ts),
+			     gfc_typename (ts), &expr->where);
+	}
+      else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
+	{
+	  /* If HOLLERITH is involved, all bets are off.  */
+	  if (gfc_option.warn_conversion_extra
+	      || gfc_option.warn_conversion)
+	    gfc_warning_now ("Conversion from %s to %s at %L",
+			     gfc_typename (&from_ts), gfc_typename (ts),
+			     &expr->where);
+	}
+      else
+        gcc_unreachable ();
     }
 
   /* Insert a pre-resolved function call to the right function.  */