decl.c (match_old_style_init): Use a clearer error message.

2019-08-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	* decl.c (match_old_style_init): Use a clearer error message.
	* expr.c (gfc_check_assign): Update BOZ checking to provide a stricter
	adherence to the Fortran standard.  Use gfc_invalid_boz () to
	relax errors into warnings.
	* gfortran.h (gfc_isym_id): Add new ids GFC_ISYM_DFLOAT,
	GFC_ISYM_FLOAT, GFC_ISYM_REALPART, and GFC_ISYM_SNGL
	* intrinsic.c (add_functions): Use new ids to split REAL generic into
	REAL, FLOAT, DFLOAT, SNGL, and REALPART generics.
	(gfc_intrinsic_func_interface): Allow new intrinsics in an
	initialization expression
	* resolve.c (resolve_operator): Deal with BOZ as operands.
        Use gfc_invalid_boz to allow for errors or warnings via the
	-fallow-invalid-boz option.  A BOZ cannot be an operand to an
	unary operator.  Both operands of a binary operator cannot be BOZ.
        For binary operators, convert a BOZ operand into the type and
	kind of the other operand for REAL or INTEGER operand.
	* trans-intrinsic.c: Use new ids to cause conversions to happen.

2019-08-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.dg/boz_8.f90: Adjust error messages.
	* gfortran.dg/nan_4.f90: Ditto.
	* gfortran.dg/boz_1.f90: Add -fallow-invalid-boz to dg-options,
	and test for warnings.
	* gfortran.dg/boz_3.f90: Ditto.
	* gfortran.dg/boz_4.f90: Ditto.
	* gfortran.dg/dec_structure_6.f90: Ditto.
	* gfortran.dg/ibits.f90: Ditto.

From-SVN: r274257

7 files changed, 126 insertions, 24 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e28e704..51dc893 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,23 @@
+2019-08-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* decl.c (match_old_style_init): Use a clearer error message.
+	* expr.c (gfc_check_assign): Update BOZ checking to provide a stricter
+	adherence to the Fortran standard.  Use gfc_invalid_boz () to
+	relax errors into warnings.
+	* gfortran.h (gfc_isym_id): Add new ids GFC_ISYM_DFLOAT,
+	GFC_ISYM_FLOAT, GFC_ISYM_REALPART, and GFC_ISYM_SNGL
+	* intrinsic.c (add_functions): Use new ids to split REAL generic into
+	REAL, FLOAT, DFLOAT, SNGL, and REALPART generics.
+	(gfc_intrinsic_func_interface): Allow new intrinsics in an
+	initialization expression
+	* resolve.c (resolve_operator): Deal with BOZ as operands.
+        Use gfc_invalid_boz to allow for errors or warnings via the
+	-fallow-invalid-boz option.  A BOZ cannot be an operand to an
+	unary operator.  Both operands of a binary operator cannot be BOZ.
+        For binary operators, convert a BOZ operand into the type and
+	kind of the other operand for REAL or INTEGER operand.
+	* trans-intrinsic.c: Use new ids to cause conversions to happen.
+
 2019-08-06  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/91359
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7a442ca..436dd10 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -579,9 +579,10 @@ match_old_style_init (const char *name)
 	  && nd->var->expr->ts.type != BT_REAL
 	  && nd->value->expr->ts.type == BT_BOZ)
 	{
-	  gfc_error ("Mismatch in variable type and BOZ literal constant "
-		     "at %L in an old-style initialization",
-		     &nd->value->expr->where);
+	  gfc_error ("BOZ literal constant near %L cannot be assigned to "
+		     "a %qs variable in an old-style initialization",
+		     &nd->value->expr->where,
+		     gfc_typename (&nd->value->expr->ts));
 	  return MATCH_ERROR;
 	}
     }
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a10a17d..900242d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3641,29 +3641,44 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
       && !gfc_check_conformance (lvalue, rvalue, "array assignment"))
     return false;
 
-  if (rvalue->ts.type == BT_BOZ && lvalue->ts.type != BT_INTEGER
-      && lvalue->symtree->n.sym->attr.data
-      && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
-			  "initialize non-integer variable %qs",
-			  &rvalue->where, lvalue->symtree->n.sym->name))
-    return false;
-  else if (rvalue->ts.type == BT_BOZ && !lvalue->symtree->n.sym->attr.data
-      && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
-			  "a DATA statement and outside INT/REAL/DBLE/CMPLX",
-			  &rvalue->where))
-    return false;
-
   /* Handle the case of a BOZ literal on the RHS.  */
   if (rvalue->ts.type == BT_BOZ)
     {
-      /* FIXME BOZ.  Need gfc_invalid_boz() here?.  */
+      if (lvalue->symtree->n.sym->attr.data)
+	{
+	  if (lvalue->ts.type == BT_INTEGER
+	      && gfc_boz2int (rvalue, lvalue->ts.kind))
+	    return true;
+
+	  if (lvalue->ts.type == BT_REAL
+	      && gfc_boz2real (rvalue, lvalue->ts.kind))
+	    {
+	      if (gfc_invalid_boz ("BOZ literal constant near %L cannot "
+				   "be assigned to a REAL variable",
+				   &rvalue->where))
+		return false;
+	      return true;
+	    }
+	}
+
+      if (!lvalue->symtree->n.sym->attr.data
+	  && gfc_invalid_boz ("BOZ literal constant at %L is neither a "
+			      "data-stmt-constant nor an actual argument to "
+			      "INT, REAL, DBLE, or CMPLX intrinsic function",
+			      &rvalue->where))
+	return false;
+
       if (lvalue->ts.type == BT_INTEGER
 	  && gfc_boz2int (rvalue, lvalue->ts.kind))
 	return true;
+
       if (lvalue->ts.type == BT_REAL
 	  && gfc_boz2real (rvalue, lvalue->ts.kind))
 	return true;
 
+      gfc_error ("BOZ literal constant near %L cannot be assigned to a "
+		 "%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
+ 
       return false;
     }
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aad9e10..75e5b2f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -423,6 +423,7 @@ enum gfc_isym_id
   GFC_ISYM_C_SIZEOF,
   GFC_ISYM_DATE_AND_TIME,
   GFC_ISYM_DBLE,
+  GFC_ISYM_DFLOAT,
   GFC_ISYM_DIGITS,
   GFC_ISYM_DIM,
   GFC_ISYM_DOT_PRODUCT,
@@ -448,6 +449,7 @@ enum gfc_isym_id
   GFC_ISYM_FGET,
   GFC_ISYM_FGETC,
   GFC_ISYM_FINDLOC,
+  GFC_ISYM_FLOAT,
   GFC_ISYM_FLOOR,
   GFC_ISYM_FLUSH,
   GFC_ISYM_FNUM,
@@ -573,6 +575,7 @@ enum gfc_isym_id
   GFC_ISYM_RANGE,
   GFC_ISYM_RANK,
   GFC_ISYM_REAL,
+  GFC_ISYM_REALPART,
   GFC_ISYM_RENAME,
   GFC_ISYM_REPEAT,
   GFC_ISYM_RESHAPE,
@@ -598,6 +601,7 @@ enum gfc_isym_id
   GFC_ISYM_SIZE,
   GFC_ISYM_SLEEP,
   GFC_ISYM_SIZEOF,
+  GFC_ISYM_SNGL,
   GFC_ISYM_SPACING,
   GFC_ISYM_SPREAD,
   GFC_ISYM_SQRT,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index d0f7c10..c35ea73 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2786,12 +2786,16 @@ add_functions (void)
 	     gfc_check_real, gfc_simplify_real, gfc_resolve_real,
 	     a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
+  make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+
   /* This provides compatibility with g77.  */
-  add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+  add_sym_1 ("realpart", GFC_ISYM_REALPART, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
 	     gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
 	     a, BT_UNKNOWN, dr, REQUIRED);
 
-  add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+  make_generic ("realpart", GFC_ISYM_REALPART, GFC_STD_F77);
+
+  add_sym_1 ("float", GFC_ISYM_FLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_float, gfc_simplify_float, NULL,
 	     a, BT_INTEGER, di, REQUIRED);
 
@@ -2802,15 +2806,19 @@ add_functions (void)
       make_alias ("floatk", GFC_STD_GNU);
     }
 
-  add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+  make_generic ("float", GFC_ISYM_FLOAT, GFC_STD_F77);
+
+  add_sym_1 ("dfloat", GFC_ISYM_DFLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
 	     gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
 	     a, BT_REAL, dr, REQUIRED);
 
-  add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+  make_generic ("dfloat", GFC_ISYM_DFLOAT, GFC_STD_F77);
+
+  add_sym_1 ("sngl", GFC_ISYM_SNGL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_sngl, gfc_simplify_sngl, NULL,
 	     a, BT_REAL, dd, REQUIRED);
 
-  make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+  make_generic ("sngl", GFC_ISYM_SNGL, GFC_STD_F77);
 
   add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
@@ -4833,7 +4841,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
     }
 
   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
-       || isym->id == GFC_ISYM_CMPLX)
+       || isym->id == GFC_ISYM_CMPLX || isym->id == GFC_ISYM_FLOAT
+       || isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
       && gfc_init_expr_flag
       && !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
 			  "expression at %L", name, &expr->where))
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 70c7f82..d9ad888 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3930,6 +3930,14 @@ resolve_operator (gfc_expr *e)
     case INTRINSIC_PARENTHESES:
       if (!gfc_resolve_expr (e->value.op.op1))
 	return false;
+      if (e->value.op.op1
+	  && e->value.op.op1->ts.type == BT_BOZ && !e->value.op.op2)
+	{
+	  gfc_error ("BOZ literal constant at %L cannot be an operand of "
+		     "unary operator %qs", &e->value.op.op1->where,
+		     gfc_op2string (e->value.op.op));
+	  return false;
+	}
       break;
     }
 
@@ -3939,6 +3947,16 @@ resolve_operator (gfc_expr *e)
   op2 = e->value.op.op2;
   dual_locus_error = false;
 
+  /* op1 and op2 cannot both be BOZ.  */
+  if (op1 && op1->ts.type == BT_BOZ
+      && op2 && op2->ts.type == BT_BOZ)
+    {
+      gfc_error ("Operands at %L and %L cannot appear as operands of "
+		 "binary operator %qs", &op1->where, &op2->where,
+		 gfc_op2string (e->value.op.op));
+      return false;
+    }
+
   if ((op1 && op1->expr_type == EXPR_NULL)
       || (op2 && op2->expr_type == EXPR_NULL))
     {
@@ -4092,6 +4110,36 @@ resolve_operator (gfc_expr *e)
 	  break;
 	}
 
+      /* If op1 is BOZ, then op2 is not!.  Try to convert to type of op2.  */
+      if (op1->ts.type == BT_BOZ)
+	{
+	  if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
+				"an operand of a relational operator",
+				&op1->where))
+	    return false;
+
+	  if (op2->ts.type == BT_INTEGER && !gfc_boz2int (op1, op2->ts.kind))
+	    return false;
+
+	  if (op2->ts.type == BT_REAL && !gfc_boz2real (op1, op2->ts.kind))
+	    return false;
+	}
+
+      /* If op2 is BOZ, then op1 is not!.  Try to convert to type of op2. */
+      if (op2->ts.type == BT_BOZ)
+	{
+	  if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
+				"an operand of a relational operator",
+				&op2->where))
+	    return false;
+
+	  if (op1->ts.type == BT_INTEGER && !gfc_boz2int (op2, op1->ts.kind))
+	    return false;
+
+	  if (op1->ts.type == BT_REAL && !gfc_boz2real (op2, op1->ts.kind))
+	    return false;
+	}
+
       if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
 	{
 	  gfc_type_convert_binary (e, 1);
@@ -6432,6 +6480,7 @@ resolve_compcall (gfc_expr* e, const char **name)
       return false;
     }
 
+
   /* These must not be assign-calls!  */
   gcc_assert (!e->value.compcall.assign);
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a6e3383..8f64c38 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9930,9 +9930,13 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_CONVERSION:
-    case GFC_ISYM_REAL:
-    case GFC_ISYM_LOGICAL:
     case GFC_ISYM_DBLE:
+    case GFC_ISYM_DFLOAT:
+    case GFC_ISYM_FLOAT:
+    case GFC_ISYM_LOGICAL:
+    case GFC_ISYM_REAL:
+    case GFC_ISYM_REALPART:
+    case GFC_ISYM_SNGL:
       gfc_conv_intrinsic_conversion (se, expr);
       break;