arith.c (gfc_convert_integer, [...]): Move to ...

2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>

	* arith.c (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
	Move to ...
	* primary.c (convert_integer, convert_real, convert_complex): ... here.
	Rename and make static functions.
	(match_integer_constant): Use convert_integer
	(match_real_constant): Use convert_real.
	(match_complex_constant: Use convert_complex.
	* arith.h (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
	Remove prototypes.
	* array.c (match_array_cons_element): A BOZ cannot be a data 
	statement value.  Jump to a common exit point.
	* check.c (gfc_invalid_boz): New function.  Emit error or warning
	for a BOZ in an invalid context.
	(boz_args_check): Move to top of file to prevent need of forward
	declaration.
	(is_boz_constant): New function.  Check that BOZ expr is constant.
	(gfc_b	z2real): New function. In-place conversion of BOZ literal
	constant to REAL in accordance to F2018.
	(gfc_boz2int): New function. In-place conversion of BOZ literal
 	onstant to INTEGER in accordance to F2018.
	(gfc_check_achar, gfc_check_char, gfc_check_float): Use gfc_invalid_boz.
	Convert BOZ as needed.
	(gfc_check_bge_bgt_ble_blt): Enforce F2018 requirements on BGE, 
	BGT, BLE, and BLT intrinsic functions.
	(gfc_check_cmplx): Re-organize to check kind, if present, first.
	Convert BOZ real and/or imaginary parts as needed in accordance to
	F2018.
	(gfc_check_complex):  Use gfc_invalid_boz.  Convert BOZ as needed.
	(gfc_check_dcmplx, gfc_check_dble ): Convert BOZ as needed.
	(gfc_check_dshift):  Make dshift[lr] conform to F2018 standard.
	 gfc_check_float (gfc_expr *a)
	(gfc_check_iand_ieor_ior):  Make IAND, IEOR, and IOR conform to 
	F2018 standard.
	(gfc_check_int): Conform to F2018 standard.
	(gfc_check_intconv): Deprecate SHORT and LONG aliases for INT2 and
	INT.  Simply return for a BOZ argument. See gfc_simplify_intconv.
	(gfc_check_merge_bits): Make MERGE_BITS conform to Fortran 2018
	standard.
	(gfc_check_real): Remove incorrect comment. Check kind, if present,
	first.  Simply return for a BOZ argument. See gfc_simplify_real.
	(gfc_check_and): Re-do error handling for BOZ arguments.  Remove
	special casing ts.type != BT_INTEGER or BT_LOGICAL.
	* decl.c (match_old_style_init): Check for BOZ in old-style
	initialization.  Issue error or warning depending on
	-fallow-invalid-boz option.  Issue error if variable is not an
	INTEGER or REAL and the value is BOZ.
	* expr.c (gfc_copy_expr): Copy a BT_BOZ gfc_expr.
	(gfc_check_assign): Re-do error handling for a BOZ in an assignment
	statement.  Do in-place conversion of RHS based on LHS type of
	INTEGER or REAL.
	* gfortran.h (gfc_expr): Add a boz component.  Remove is_boz component.
	(gfc_boz2int, gfc_boz2real, gfc_invalid_boz): New prototypes.
	* interface.c (gfc_extend_assign): Guard against replacing an 
	intrinsic involving a BOZ literal constant on RHS.
	* invoke.texi: Doument -fallow-invalid-boz.
	* lang.opt: New option. -fallow-invalid-boz.
	* libgfortran.h (bt): Elevate BOZ to a basic type.
	* misc.c (gfc_basic_typename, gfc_typename): Translate BT_BOZ to BOZ.
	* primary.c (convert_integer, convert_real, convert_complex): to here.
	Rename and make static functions.
	* primary.c(match_boz_constant): Rewrite parsing of a BOZ. Re-do
	error handling.  Deprecate 'X' for hexidecimal and postfix notation.
	Use -fallow-invalid-boz and gfc_invalid_boz to accept deprecated code.
	* resolve.c (resolve_ordinary_assign): Rework a RHS that is a
	BOZ literal constant.  Use gfc_invalid_boz to allow previous
	nonstandard behavior.  Remove range checking of BOZ conversion.
	* simplify.c (convert_boz): Remove function.
	(simplify_cmplx): Remove conversion of BOZ constants, because
	conversion is done in gfc_check_cmplx.
	(gfc_simplify_float): Remove conversion of BOZ constant, because
	conversion is done in gfc_check_float.
	(simplify_intconv): Use gfc_boz2int to convert BOZ to INTEGER.
	Remove range checking for BOZ conversion.
	(gfc_simplify_real): Use k, if present, to determine kind.  Convert
	BOZ to REAL.  Remove range checking for BOZ conversion.
	target-memory.c (gfc_convert_boz): Rewrite to deal with convert of
	a BOZ to a REAL value.

2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.dg/achar_5.f90: Fix for new BOZ handling.
	* arithmetic_overflow_1.f90: Ditto.
	* gfortran.dg/boz_11.f90: Ditto.
	* gfortran.dg/boz_12.f90: Ditto.
	* gfortran.dg/boz_4.f90: Ditto.
	* gfortran.dg/boz_5.f90: Ditto.
	* gfortran.dg/boz_6.f90: Ditto.
	* gfortran.dg/boz_7.f90: Ditto.
	* gfortran.dg/boz_8.f90: Ditto.
	* gfortran.dg/dec_structure_6.f90: Ditto.
	* gfortran.dg/dec_union_1.f90: Ditto.
	* gfortran.dg/dec_union_2.f90: Ditto.
	* gfortran.dg/dec_union_5.f90: Ditto.
	* gfortran.dg/dshift_3.f90: Ditto.
	* gfortran.dg/gnu_logical_2.f90: Ditto.
	* gfortran.dg/int_conv_1.f90: Ditto.
	* gfortran.dg/ishft_1.f90: Ditto.
	* gfortran.dg/nan_4.f90: Ditto.
	* gfortran.dg/no_range_check_3.f90: Ditto.
	* gfortran.dg/pr16433.f: Ditto.
	* gfortran.dg/pr44491.f90: Ditto.
	* gfortran.dg/pr58027.f90: Ditto.
	* gfortran.dg/pr81509_2.f90: Ditto.
	* gfortran.dg/unf_io_convert_1.f90: Ditto.
	* gfortran.dg/unf_io_convert_2.f90: Ditto.
	* gfortran.fortran-torture/execute/intrinsic_fraction_exponent.f90:
	Ditto.
	* gfortran.fortran-torture/execute/intrinsic_mvbits.f90: Ditto.
	* gfortran.fortran-torture/execute/intrinsic_nearest.f90: Ditto.
	* gfortran.fortran-torture/execute/seq_io.f90: Ditto.
	* gfortran.dg/gnu_logical_1.F: Delete test.
	* gfortran.dg/merge_bits_3.f90: New test.
	* gfortran.dg/merge_bits_3.f90: Ditto.
	* gfortran.dg/boz_int.f90: Ditto.
	* gfortran.dg/boz_bge.f90: Ditto.
	* gfortran.dg/boz_complex_1.f90: Ditto.
	* gfortran.dg/boz_complex_2.f90: Ditto.
	* gfortran.dg/boz_complex_3.f90: Ditto.
	* gfortran.dg/boz_dble.f90: Ditto.
	* gfortran.dg/boz_dshift_1.f90: Ditto.
	* gfortran.dg/boz_dshift_2.f90: Ditto.
	* gfortran.dg/boz_float_1.f90: Ditto.
	* gfortran.dg/boz_float_2.f90: Ditto.
	* gfortran.dg/boz_float_3.f90: Ditto.
	* gfortran.dg/boz_iand_1.f90: Ditto.
	* gfortran.dg/boz_iand_2.f90: Ditto.

2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>

	* testsuite/libgomp.fortran/reduction4.f90: Update BOZ usage
	* testsuite/libgomp.fortran/reduction5.f90: Ditto.

From-SVN: r273747

17 files changed, 710 insertions, 314 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c4c35ad..7cac310 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,83 @@
+2019-07-23  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* arith.c (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
+	Move to ...
+	* primary.c (convert_integer, convert_real, convert_complex): ... here.
+	Rename and make static functions.
+	(match_integer_constant): Use convert_integer
+	(match_real_constant): Use convert_real.
+	(match_complex_constant: Use convert_complex.
+	* arith.h (gfc_convert_integer, gfc_convert_real, gfc_convert_complex):
+	Remove prototypes.
+	* array.c (match_array_cons_element): A BOZ cannot be a data 
+	statement value.  Jump to a common exit point.
+	* check.c (gfc_invalid_boz): New function.  Emit error or warning
+	for a BOZ in an invalid context.
+	(boz_args_check): Move to top of file to prevent need of forward
+	declaration.
+	(is_boz_constant): New function.  Check that BOZ expr is constant.
+	(gfc_boz2real): New function. In-place conversion of BOZ literal
+	constant to REAL in accordance to F2018.
+	(gfc_boz2int): New function. In-place conversion of BOZ literal
+	constant to INTEGER in accordance to F2018.
+	(gfc_check_achar, gfc_check_char, gfc_check_float): Use gfc_invalid_boz.  Convert BOZ
+	as needed.
+	(gfc_check_bge_bgt_ble_blt): Enforce F2018 requirements on BGE, 
+	BGT, BLE, and BLT intrinsic functions.
+	(gfc_check_cmplx): Re-organize to check kind, if present, first.
+	Convert BOZ real and/or imaginary parts as needed in accordance to
+	F2018.
+	(gfc_check_complex):  Use gfc_invalid_boz.  Convert BOZ as needed.
+	(gfc_check_dcmplx, gfc_check_dble ): Convert BOZ as needed.
+	(gfc_check_dshift):  Make dshift[lr] conform to F2018 standard.
+ 	gfc_check_float (gfc_expr *a)
+	(gfc_check_iand_ieor_ior):  Make IAND, IEOR, and IOR conform to 
+	F2018 standard.
+	(gfc_check_int): Conform to F2018 standard.
+	(gfc_check_intconv): Deprecate SHORT and LONG aliases for INT2 and
+	INT.  Simply return for a BOZ argument. See gfc_simplify_intconv.
+	(gfc_check_merge_bits): Make MERGE_BITS conform to Fortran 2018
+	standard.
+	(gfc_check_real): Remove incorrect comment. Check kind, if present,
+	first.  Simply return for a BOZ argument. See gfc_simplify_real.
+	(gfc_check_and): Re-do error handling for BOZ arguments.  Remove
+	special casing ts.type != BT_INTEGER or BT_LOGICAL.
+	* decl.c (match_old_style_init): Check for BOZ in old-style
+	initialization.  Issue error or warning depending on
+	-fallow-invalid-boz option.  Issue error if variable is not an
+	INTEGER or REAL and the value is BOZ.
+	* expr.c (gfc_copy_expr): Copy a BT_BOZ gfc_expr.
+	(gfc_check_assign): Re-do error handling for a BOZ in an assignment
+	statement.  Do in-place conversion of RHS based on LHS type of
+	INTEGER or REAL.
+	* gfortran.h (gfc_expr): Add a boz component.  Remove is_boz component.
+	(gfc_boz2int, gfc_boz2real, gfc_invalid_boz): New prototypes.
+	* interface.c (gfc_extend_assign): Guard against replacing an 
+	intrinsic involving a BOZ literal constant on RHS.
+	* invoke.texi: Doument -fallow-invalid-boz.
+	* lang.opt: New option. -fallow-invalid-boz.
+	* libgfortran.h (bt): Elevate BOZ to a basic type.
+	* misc.c (gfc_basic_typename, gfc_typename): Translate BT_BOZ to BOZ.
+	* primary.c (convert_integer, convert_real, convert_complex): to here.
+	Rename and make static functions.
+	* primary.c(match_boz_constant): Rewrite parsing of a BOZ. Re-do
+	error handling.  Deprecate 'X' for hexidecimal and postfix notation.
+	Use -fallow-invalid-boz and gfc_invalid_boz to accept deprecated code.
+	* resolve.c (resolve_ordinary_assign): Rework a RHS that is a
+	BOZ literal constant.  Use gfc_invalid_boz to allow previous
+	nonstandard behavior.  Remove range checking of BOZ conversion.
+	* simplify.c (convert_boz): Remove function.
+	(simplify_cmplx): Remove conversion of BOZ constants, because
+	conversion is done in gfc_check_cmplx.
+	(gfc_simplify_float): Remove conversion of BOZ constant, because
+	conversion is done in gfc_check_float.
+	(simplify_intconv): Use gfc_boz2int to convert BOZ to INTEGER.
+	Remove range checking for BOZ conversion.
+	(gfc_simplify_real): Use k, if present, to determine kind.  Convert
+	BOZ to REAL.  Remove range checking for BOZ conversion.
+	target-memory.c (gfc_convert_boz): Rewrite to deal with convert of
+	a BOZ to a REAL value.
+
 2019-07-21  Thomas König  <tkoenig@gcc.gnu.org>
 
 	PR libfortran/91030
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index a4f8795..ff279db 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1892,56 +1892,6 @@ gfc_le (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
 }
 
 
-/* Convert an integer string to an expression node.  */
-
-gfc_expr *
-gfc_convert_integer (const char *buffer, int kind, int radix, locus *where)
-{
-  gfc_expr *e;
-  const char *t;
-
-  e = gfc_get_constant_expr (BT_INTEGER, kind, where);
-  /* A leading plus is allowed, but not by mpz_set_str.  */
-  if (buffer[0] == '+')
-    t = buffer + 1;
-  else
-    t = buffer;
-  mpz_set_str (e->value.integer, t, radix);
-
-  return e;
-}
-
-
-/* Convert a real string to an expression node.  */
-
-gfc_expr *
-gfc_convert_real (const char *buffer, int kind, locus *where)
-{
-  gfc_expr *e;
-
-  e = gfc_get_constant_expr (BT_REAL, kind, where);
-  mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
-
-  return e;
-}
-
-
-/* Convert a pair of real, constant expression nodes to a single
-   complex expression node.  */
-
-gfc_expr *
-gfc_convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
-{
-  gfc_expr *e;
-
-  e = gfc_get_constant_expr (BT_COMPLEX, kind, &real->where);
-  mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
-		 GFC_MPC_RND_MODE);
-
-  return e;
-}
-
-
 /******* Simplification of intrinsic functions with constant arguments *****/
 
 
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index e06c705..39366ca 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -59,11 +59,6 @@ gfc_expr *gfc_ge (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
 gfc_expr *gfc_lt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
 gfc_expr *gfc_le (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
 
-/* Convert strings to literal constants.  */
-gfc_expr *gfc_convert_integer (const char *, int, int, locus *);
-gfc_expr *gfc_convert_real (const char *, int, locus *);
-gfc_expr *gfc_convert_complex (gfc_expr *, gfc_expr *, int);
-
 /* Convert a constant of one kind to another kind.  */
 gfc_expr *gfc_int2int (gfc_expr *, int);
 gfc_expr *gfc_int2real (gfc_expr *, int);
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 0aee220..396dd97 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1110,17 +1110,27 @@ match_array_cons_element (gfc_constructor_base *result)
   if (m != MATCH_YES)
     return m;
 
+  if (expr->ts.type == BT_BOZ)
+    {
+      gfc_error ("BOZ literal constant at %L cannot appear in an "
+		 "array constructor", &expr->where);
+      goto done;
+    }
+
   if (expr->expr_type == EXPR_FUNCTION
       && expr->ts.type == BT_UNKNOWN
       && strcmp(expr->symtree->name, "null") == 0)
-   {
+    {
       gfc_error ("NULL() at %C cannot appear in an array constructor");
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-   }
+      goto done;
+    }
 
   gfc_constructor_append_expr (result, expr, &gfc_current_locus);
   return MATCH_YES;
+
+done:
+  gfc_free_expr (expr);
+  return MATCH_ERROR;
 }
 
 
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 9580180..1543f13 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -34,6 +34,225 @@ along with GCC; see the file COPYING3.  If not see
 #include "constructor.h"
 #include "target-memory.h"
 
+/* A BOZ literal constant can appear in a limited number of contexts.
+   gfc_invalid_boz() is a help function to simplify error/warning generation.
+   Note, gfortran accepts the nonstandard 'X' for 'Z' the nonstandard
+   suffix location.  If -fallow-invalid-boz is used, then issue a warning;
+   otherwise issue an error.  */
+
+bool
+gfc_invalid_boz (const char *msg, locus *loc)
+{
+  if (flag_allow_invalid_boz)
+    {
+      gfc_warning (0, msg, loc);
+      return false;
+    }
+
+  gfc_error (msg, loc);
+  return true;
+}
+
+
+/* Some precedures take two arguments such that both cannot be BOZ.  */
+
+static bool
+boz_args_check(gfc_expr *i, gfc_expr *j)
+{
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_BOZ)
+    {
+      gfc_error ("Arguments of %qs at %L and %L cannot both be BOZ "
+		 "literal constants", gfc_current_intrinsic, &i->where,
+		 &j->where);
+      return false;
+
+    }
+
+  return true;
+}
+
+
+/* Check that a BOZ is a constant.  */
+
+static bool
+is_boz_constant (gfc_expr *a)
+{
+  if (a->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("Invalid use of BOZ literal constant at %L", &a->where);
+      return false;
+    }
+
+  return true;
+}
+
+
+/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2real () 
+   converts the string into a REAL of the appropriate kind.  The treatment
+   of the sign bit is processor dependent.  */
+
+bool
+gfc_boz2real (gfc_expr *x, int kind)
+{
+  extern int gfc_max_integer_kind;
+  gfc_typespec ts;
+  int len;
+  char *buf, *str;
+
+  if (!is_boz_constant (x))
+    return false;
+
+  /* Determine the length of the required string.  */
+  len = 8 * kind;
+  if (x->boz.rdx == 16) len /= 4;
+  if (x->boz.rdx == 8) len = len / 3 + 1;
+  buf = (char *) alloca (len + 1);		/* +1 for NULL terminator.  */
+
+  if (x->boz.len >= len)			/* Truncate if necessary.  */
+    {
+      str = x->boz.str + (x->boz.len - len);
+      strcpy(buf, str);
+    }
+  else						/* Copy and pad. */
+    {
+      memset (buf, 48, len);
+      str = buf + (len - x->boz.len);
+      strcpy (str, x->boz.str);
+    }
+
+  /* Need to adjust leading bits in an octal string.  */
+  if (x->boz.rdx == 8)
+    {
+      /* Clear first bit.  */
+      if (kind == 4 || kind == 10 || kind == 16)
+	{
+	  if (buf[0] == '4')
+	    buf[0] = '0';
+	  else if (buf[0] == '5')
+	    buf[0] = '1';
+	  else if (buf[0] == '6')
+	    buf[0] = '2';
+	  else if (buf[0] == '7')
+	    buf[0] = '3';
+	}
+      /* Clear first two bits.  */
+      else
+	{
+	  if (buf[0] == '4' || buf[0] == '6')
+	    buf[0] = '0';
+	  else if (buf[0] == '5' || buf[0] == '7')
+	    buf[0] = '1';
+	}
+    }
+ 
+  /* Reset BOZ string to the truncated or padded version.  */
+  free (x->boz.str);
+  x->boz.len = len;
+  x->boz.str = XCNEWVEC (char, len + 1);
+  strncpy (x->boz.str, buf, len);
+
+  /* Convert to widest possible integer.  */
+  gfc_boz2int (x, gfc_max_integer_kind);
+  ts.type = BT_REAL;
+  ts.kind = kind;
+  if (!gfc_convert_boz (x, &ts))
+    {
+      gfc_error ("Failure in conversion of BOZ to REAL at %L", &x->where);
+      return false;
+    }
+
+  return true;
+}
+
+
+/* Fortran 2018 treats a BOZ as simply a string of bits.  gfc_boz2int () 
+   converts the string into an INTEGER of the appropriate kind.  The
+   treatment of the sign bit is processor dependent.  If the  converted
+   value exceeds the range of the type, then wrap-around semantics are
+   applied.  */
+ 
+bool
+gfc_boz2int (gfc_expr *x, int kind)
+{
+  int i, len;
+  char *buf, *str;
+  mpz_t tmp1;
+
+  if (!is_boz_constant (x))
+    return false;
+
+  i = gfc_validate_kind (BT_INTEGER, kind, false);
+  len = gfc_integer_kinds[i].bit_size;
+  if (x->boz.rdx == 16) len /= 4;
+  if (x->boz.rdx == 8) len = len / 3 + 1;
+  buf = (char *) alloca (len + 1);		/* +1 for NULL terminator.  */
+
+  if (x->boz.len >= len)			/* Truncate if necessary.  */
+    {
+      str = x->boz.str + (x->boz.len - len);
+      strcpy(buf, str);
+    }
+  else						/* Copy and pad. */
+    {
+      memset (buf, 48, len);
+      str = buf + (len - x->boz.len);
+      strcpy (str, x->boz.str);
+    }
+
+  /* Need to adjust leading bits in an octal string.  */
+  if (x->boz.rdx == 8)
+    {
+      /* Clear first bit.  */
+      if (kind == 1 || kind == 4 || kind == 16)
+	{
+	  if (buf[0] == '4')
+	    buf[0] = '0';
+	  else if (buf[0] == '5')
+	    buf[0] = '1';
+	  else if (buf[0] == '6')
+	    buf[0] = '2';
+	  else if (buf[0] == '7')
+	    buf[0] = '3';
+	}
+      /* Clear first two bits.  */
+      else
+	{
+	  if (buf[0] == '4' || buf[0] == '6')
+	    buf[0] = '0';
+	  else if (buf[0] == '5' || buf[0] == '7')
+	    buf[0] = '1';
+	}
+    }
+
+  /* Convert as-if unsigned integer.  */
+  mpz_init (tmp1);
+  mpz_set_str (tmp1, buf, x->boz.rdx);
+
+  /* Check for wrap-around.  */
+  if (mpz_cmp (tmp1, gfc_integer_kinds[i].huge) > 0)
+    {
+      mpz_t tmp2;
+      mpz_init (tmp2);
+      mpz_add_ui (tmp2, gfc_integer_kinds[i].huge, 1);
+      mpz_mod (tmp1, tmp1, tmp2);
+      mpz_sub (tmp1, tmp1, tmp2);
+      mpz_clear (tmp2);
+    }
+
+  /* Clear boz info.  */
+  x->boz.rdx = 0;
+  x->boz.len = 0;
+  free (x->boz.str);
+
+  mpz_init (x->value.integer);
+  mpz_set (x->value.integer, tmp1);
+  x->ts.type = BT_INTEGER;
+  x->ts.kind = kind;
+  mpz_clear (tmp1);
+
+  return true;
+}
+
 
 /* Make sure an expression is a scalar.  */
 
@@ -880,8 +1099,19 @@ gfc_check_abs (gfc_expr *a)
 bool
 gfc_check_achar (gfc_expr *a, gfc_expr *kind)
 {
+  if (a->ts.type == BT_BOZ)
+    {
+      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
+			   "ACHAR intrinsic subprogram", &a->where))
+	return false;
+
+      if (!gfc_boz2int (a, gfc_default_integer_kind))
+	return false;
+    }
+
   if (!type_check (a, 0, BT_INTEGER))
     return false;
+
   if (!kind_check (kind, 1, BT_CHARACTER))
     return false;
 
@@ -1471,6 +1701,27 @@ gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
 bool
 gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
 {
+  extern int gfc_max_integer_kind;
+
+  /* If i and j are both BOZ, convert to widest INTEGER.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_BOZ)
+    {
+      if (!gfc_boz2int (i, gfc_max_integer_kind))
+	return false;
+      if (!gfc_boz2int (j, gfc_max_integer_kind))
+	return false;
+    }
+
+  /* If i is BOZ and j is integer, convert i to type of j.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+      && !gfc_boz2int (i, j->ts.kind))
+    return false;
+
+  /* If j is BOZ and i is integer, convert j to type of i.  */
+  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+      && !gfc_boz2int (j, i->ts.kind))
+    return false;
+
   if (!type_check (i, 0, BT_INTEGER))
     return false;
 
@@ -1503,8 +1754,19 @@ gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
 bool
 gfc_check_char (gfc_expr *i, gfc_expr *kind)
 {
+  if (i->ts.type == BT_BOZ)
+    {
+      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
+			   "CHAR intrinsic subprogram", &i->where))
+	return false;
+
+      if (!gfc_boz2int (i, gfc_default_integer_kind))
+	return false;
+    }
+
   if (!type_check (i, 0, BT_INTEGER))
     return false;
+
   if (!kind_check (kind, 1, BT_CHARACTER))
     return false;
 
@@ -1590,11 +1852,29 @@ gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status)
 bool
 gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 {
+  int k;
+
+  /* Check kind first, because it may be needed in conversion of a BOZ.  */
+  if (kind)
+    {
+      if (!kind_check (kind, 2, BT_COMPLEX))
+	return false;
+      gfc_extract_int (kind, &k);
+    }
+  else
+    k = gfc_default_complex_kind;
+
+  if (x->ts.type == BT_BOZ && !gfc_boz2real (x, k))
+    return false;
+
   if (!numeric_check (x, 0))
     return false;
 
   if (y != NULL)
     {
+      if (y->ts.type == BT_BOZ && !gfc_boz2real (y, k))
+	return false;
+
       if (!numeric_check (y, 1))
 	return false;
 
@@ -1615,12 +1895,8 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 		     &y->where);
 	  return false;
 	}
-
     }
 
-  if (!kind_check (kind, 2, BT_COMPLEX))
-    return false;
-
   if (!kind && warn_conversion
       && x->ts.type == BT_REAL && x->ts.kind > gfc_default_real_kind)
     gfc_warning_now (OPT_Wconversion, "Conversion from %s to default-kind "
@@ -1926,6 +2202,33 @@ gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
 bool
 gfc_check_complex (gfc_expr *x, gfc_expr *y)
 {
+
+  /* FIXME BOZ.  What to do with complex?  */
+  if (!boz_args_check (x, y))
+    return false;
+
+  if (x->ts.type == BT_BOZ)
+    {
+      if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
+			   "intrinsic subprogram", &x->where))
+	return false;
+      if (y->ts.type == BT_INTEGER && !gfc_boz2int (x, y->ts.kind))
+	return false;
+      if (y->ts.type == BT_REAL && !gfc_boz2real (x, y->ts.kind))
+    	return false;
+    }
+
+  if (y->ts.type == BT_BOZ)
+    {
+      if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
+			   "intrinsic subprogram", &y->where))
+	return false;
+      if (x->ts.type == BT_INTEGER && !gfc_boz2int (y, x->ts.kind))
+	return false;
+      if (x->ts.type == BT_REAL && !gfc_boz2real (y, x->ts.kind))
+	return false;
+    }
+
   if (!int_or_real_check (x, 0))
     return false;
   if (!scalar_check (x, 0))
@@ -2047,11 +2350,17 @@ bool gfc_check_datan2 (gfc_expr *y, gfc_expr *x)
 bool
 gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 {
+  if (x->ts.type == BT_BOZ && !gfc_boz2real (x, gfc_default_double_kind))
+    return false;
+
   if (!numeric_check (x, 0))
     return false;
 
   if (y != NULL)
     {
+      if (y->ts.type == BT_BOZ && !gfc_boz2real (y, gfc_default_double_kind))
+	return false;
+
       if (!numeric_check (y, 1))
 	return false;
 
@@ -2081,6 +2390,9 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 bool
 gfc_check_dble (gfc_expr *x)
 {
+  if (x->ts.type == BT_BOZ && !gfc_boz2real (x, gfc_default_double_kind))
+    return false;
+
   if (!numeric_check (x, 0))
     return false;
 
@@ -2167,35 +2479,30 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
   return true;
 }
 
-
-static bool
-boz_args_check(gfc_expr *i, gfc_expr *j)
+bool
+gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
 {
-  if (i->is_boz && j->is_boz)
-    {
-      gfc_error ("Arguments of %qs at %L and %L cannot both be BOZ "
-		 "literal constants", gfc_current_intrinsic, &i->where,
-		 &j->where);
-      return false;
+  /* i and j cannot both be BOZ literal constants.  */
+  if (!boz_args_check (i, j))
+    return false;
 
-    }
-  return true;
-}
+  /* If i is BOZ and j is integer, convert i to type of j.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+      && !gfc_boz2int (i, j->ts.kind))
+    return false;
 
+  /* If j is BOZ and i is integer, convert j to type of i.  */
+  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+      && !gfc_boz2int (j, i->ts.kind))
+    return false;
 
-bool
-gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
-{
   if (!type_check (i, 0, BT_INTEGER))
     return false;
 
   if (!type_check (j, 1, BT_INTEGER))
     return false;
 
-  if (!boz_args_check (i, j))
-    return false;
-
-  if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1))
+  if (!same_type_check (i, 0, j, 1))
     return false;
 
   if (!type_check (shift, 2, BT_INTEGER))
@@ -2204,18 +2511,8 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
   if (!nonnegative_check ("SHIFT", shift))
     return false;
 
-  if (i->is_boz)
-    {
-      if (!less_than_bitsize1 ("J", j, "SHIFT", shift, true))
-    	return false;
-      i->ts.kind = j->ts.kind;
-    }
-  else
-    {
-      if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true))
-    	return false;
-      j->ts.kind = i->ts.kind;
-    }
+  if (!less_than_bitsize1 ("I", i, "SHIFT", shift, true))
+    return false;
 
   return true;
 }
@@ -2367,9 +2664,19 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
   return true;
 }
 
+
 bool
 gfc_check_float (gfc_expr *a)
 {
+  if (a->ts.type == BT_BOZ)
+    {
+      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in the "
+			   "FLOAT intrinsic subprogram", &a->where))
+	return false;
+      if (!gfc_boz2int (a, gfc_default_integer_kind))
+	return false;
+    }
+
   if (!type_check (a, 0, BT_INTEGER))
     return false;
 
@@ -2495,17 +2802,25 @@ gfc_check_i (gfc_expr *i)
 bool
 gfc_check_iand_ieor_ior (gfc_expr *i, gfc_expr *j)
 {
-  if (!type_check (i, 0, BT_INTEGER))
+  /* i and j cannot both be BOZ literal constants.  */
+  if (!boz_args_check (i, j))
     return false;
 
-  if (!type_check (j, 1, BT_INTEGER))
+  /* If i is BOZ and j is integer, convert i to type of j.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+      && !gfc_boz2int (i, j->ts.kind))
     return false;
 
-  if (!boz_args_check (i, j))
+  /* If j is BOZ and i is integer, convert j to type of i.  */
+  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+      && !gfc_boz2int (j, i->ts.kind))
+    return false;
+
+  if (!type_check (i, 0, BT_INTEGER))
     return false;
 
-  if (i->is_boz) i->ts.kind = j->ts.kind;
-  if (j->is_boz) j->ts.kind = i->ts.kind;
+  if (!type_check (j, 1, BT_INTEGER))
+    return false;
 
   if (i->ts.kind != j->ts.kind)
     {
@@ -2658,6 +2973,10 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
 bool
 gfc_check_int (gfc_expr *x, gfc_expr *kind)
 {
+  /* BOZ is dealt within simplify_int*.  */
+  if (x->ts.type == BT_BOZ)
+    return true;
+
   if (!numeric_check (x, 0))
     return false;
 
@@ -2671,6 +2990,19 @@ gfc_check_int (gfc_expr *x, gfc_expr *kind)
 bool
 gfc_check_intconv (gfc_expr *x)
 {
+  if (strcmp (gfc_current_intrinsic, "short") == 0
+      || strcmp (gfc_current_intrinsic, "long") == 0)
+    {
+      gfc_error ("%qs intrinsic subprogram at %L has been deprecated.  "
+		 "Use INT intrinsic subprogram.", gfc_current_intrinsic, 
+		 &x->where);
+      return false;
+    }
+
+  /* BOZ is dealt within simplify_int*.  */
+  if (x->ts.type == BT_BOZ)
+    return true;
+
   if (!numeric_check (x, 0))
     return false;
 
@@ -3554,28 +3886,37 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
 bool
 gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask)
 {
-  if (!type_check (i, 0, BT_INTEGER))
+  /* i and j cannot both be BOZ literal constants.  */
+  if (!boz_args_check (i, j))
     return false;
 
-  if (!type_check (j, 1, BT_INTEGER))
+  /* If i is BOZ and j is integer, convert i to type of j.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+      && !gfc_boz2int (i, j->ts.kind))
     return false;
 
-  if (!boz_args_check (i, j))
+  /* If j is BOZ and i is integer, convert j to type of i.  */
+  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+      && !gfc_boz2int (j, i->ts.kind))
     return false;
 
-  if (i->is_boz) i->ts.kind = j->ts.kind;
-  if (j->is_boz) j->ts.kind = i->ts.kind;
+  if (!type_check (i, 0, BT_INTEGER))
+    return false;
 
-  if (!type_check (mask, 2, BT_INTEGER))
+  if (!type_check (j, 1, BT_INTEGER))
     return false;
 
   if (!same_type_check (i, 0, j, 1))
     return false;
 
-  if (!same_type_check (i, 0, mask, 2))
+  if (mask->ts.type == BT_BOZ && !gfc_boz2int(mask, i->ts.kind))
+    return false;
+
+  if (!type_check (mask, 2, BT_INTEGER))
     return false;
 
-  if (mask->is_boz) mask->ts.kind = i->ts.kind;
+  if (!same_type_check (i, 0, mask, 2))
+    return false;
 
   return true;
 }
@@ -3977,14 +4318,17 @@ gfc_check_rank (gfc_expr *a)
 }
 
 
-/* real, float, sngl.  */
 bool
 gfc_check_real (gfc_expr *a, gfc_expr *kind)
 {
-  if (!numeric_check (a, 0))
+  if (!kind_check (kind, 1, BT_REAL))
     return false;
 
-  if (!kind_check (kind, 1, BT_REAL))
+  /* BOZ is dealt with in gfc_simplify_real.  */
+  if (a->ts.type == BT_BOZ)
+    return true;
+
+  if (!numeric_check (a, 0))
     return false;
 
   return true;
@@ -6726,42 +7070,28 @@ gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
 bool
 gfc_check_and (gfc_expr *i, gfc_expr *j)
 {
-  if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
-    {
-      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
-		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
-		 gfc_current_intrinsic, &i->where);
-      return false;
-    }
-
-  if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
-    {
-      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
-		 "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
-		 gfc_current_intrinsic, &j->where);
-      return false;
-    }
+  /* i and j cannot both be BOZ literal constants.  */
+  if (!boz_args_check (i, j))
+    return false;
 
-  if (i->ts.type != j->ts.type)
-    {
-      gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
-		 "have the same type", gfc_current_intrinsic_arg[0]->name,
-		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
-		 &j->where);
-      return false;
-    }
+  /* If i is BOZ and j is integer, convert i to type of j.  */
+  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
+      && !gfc_boz2int (i, j->ts.kind))
+    return false;
 
-  if (!scalar_check (i, 0))
+  /* If j is BOZ and i is integer, convert j to type of i.  */
+  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
+      && !gfc_boz2int (j, i->ts.kind))
     return false;
 
-  if (!scalar_check (j, 1))
+  if (!same_type_check (i, 0, j, 1, false))
     return false;
 
-  if (!boz_args_check (i, j))
+  if (!scalar_check (i, 0))
     return false;
 
-  if (i->is_boz) i->ts.kind = j->ts.kind;
-  if (j->is_boz) j->ts.kind = i->ts.kind;
+  if (!scalar_check (j, 1))
+    return false;
 
   return true;
 }
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3d29091..a7886b0 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -547,7 +547,7 @@ match_old_style_init (const char *name)
   match m;
   gfc_symtree *st;
   gfc_symbol *sym;
-  gfc_data *newdata;
+  gfc_data *newdata, *nd;
 
   /* Set up data structure to hold initializers.  */
   gfc_find_sym_tree (name, NULL, 0, &st);
@@ -567,6 +567,25 @@ match_old_style_init (const char *name)
       return m;
     }
 
+  /* Check that a BOZ did not creep into an old-style initialization.  */
+  for (nd = newdata; nd; nd = nd->next)
+    {
+      if (nd->value->expr->ts.type == BT_BOZ
+	  && gfc_invalid_boz ("BOZ at %L cannot appear in an old-style "
+			      "initialization", &nd->value->expr->where))
+	return MATCH_ERROR;
+
+      if (nd->var->expr->ts.type != BT_INTEGER
+	  && 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);
+	  return MATCH_ERROR;
+	}
+    }
+
   if (gfc_pure (NULL))
     {
       gfc_error ("Initialization at %C is not allowed in a PURE procedure");
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a164370..a10a17d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -342,6 +342,13 @@ gfc_copy_expr (gfc_expr *p)
 	case BT_ASSUMED:
 	  break;		/* Already done.  */
 
+	case BT_BOZ:
+	  q->boz.len = p->boz.len;
+	  q->boz.rdx = p->boz.rdx;
+	  q->boz.str = XCNEWVEC (char, q->boz.len + 1);
+	  strncpy (q->boz.str, p->boz.str, p->boz.len);
+	  break;
+
 	case BT_PROCEDURE:
         case BT_VOID:
            /* Should never be reached.  */
@@ -3634,45 +3641,30 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
       && !gfc_check_conformance (lvalue, rvalue, "array assignment"))
     return false;
 
-  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
+  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->is_boz && !lvalue->symtree->n.sym->attr.data
+  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->is_boz && lvalue->ts.type != BT_INTEGER)
-    {
-      int rc;
-      if (warn_surprising)
-	gfc_warning (OPT_Wsurprising,
-		     "BOZ literal at %L is bitwise transferred "
-		     "non-integer symbol %qs", &rvalue->where,
-		     lvalue->symtree->n.sym->name);
-      if (!gfc_convert_boz (rvalue, &lvalue->ts))
-	return false;
-      if ((rc = gfc_range_check (rvalue)) != ARITH_OK)
-	{
-	  if (rc == ARITH_UNDERFLOW)
-	    gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rvalue->where);
-	  else if (rc == ARITH_OVERFLOW)
-	    gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rvalue->where);
-	  else if (rc == ARITH_NAN)
-	    gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rvalue->where);
-	  return false;
-	}
+  if (rvalue->ts.type == BT_BOZ)
+    {
+      /* FIXME BOZ.  Need gfc_invalid_boz() here?.  */
+      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;
+
+      return false;
     }
 
   if (gfc_expr_attr (lvalue).pdt_kind || gfc_expr_attr (lvalue).pdt_len)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1f7bd0..700e6dc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2152,9 +2152,8 @@ typedef struct gfc_expr
      is not a variable.  */
   struct gfc_expr *base_expr;
 
-  /* is_boz is true if the integer is regarded as BOZ bit pattern and is_snan
-     denotes a signalling not-a-number.  */
-  unsigned int is_boz : 1, is_snan : 1;
+  /* is_snan denotes a signalling not-a-number.  */
+  unsigned int is_snan : 1;
 
   /* Sometimes, when an error has been emitted, it is necessary to prevent
       it from recurring.  */
@@ -2198,6 +2197,14 @@ typedef struct gfc_expr
   }
   representation;
 
+  struct
+  {
+    int len;	/* Length of BOZ string without terminating NULL.  */
+    int rdx;	/* Radix of BOZ.  */
+    char *str;	/* BOZ string with NULL terminating character.  */
+  }
+  boz;
+
   union
   {
     int logical;
@@ -3479,6 +3486,10 @@ bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *);
 bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
 bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*,
 				      size_t*, size_t*, size_t*);
+bool gfc_boz2int (gfc_expr *, int);
+bool gfc_boz2real (gfc_expr *, int);
+bool gfc_invalid_boz (const char *, locus *);
+
 
 /* class.c */
 void gfc_fix_class_refs (gfc_expr *e);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 3f91f6b..f971586 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -4274,6 +4274,12 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
   lhs = c->expr1;
   rhs = c->expr2;
 
+  /* Don't allow an intrinsic assignment with a BOZ rhs to be replaced.  */
+  if (c->op == EXEC_ASSIGN
+      && c->expr1->expr_type == EXPR_VARIABLE
+      && c->expr2->expr_type == EXPR_CONSTANT && c->expr2->ts.type == BT_BOZ)
+    return false;
+
   /* Don't allow an intrinsic assignment to be replaced.  */
   if (lhs->ts.type != BT_DERIVED && lhs->ts.type != BT_CLASS
       && (rhs->rank == 0 || rhs->rank == lhs->rank)
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index f8efcd8..5d538fa 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -116,13 +116,13 @@ by type.  Explanations are in the following sections.
 @table @emph
 @item Fortran Language Options
 @xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
-@gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
--fd-lines-as-comments -fdec -fdec-structure -fdec-intrinsic-ints @gol
--fdec-static -fdec-math -fdec-include -fdec-format-defaults @gol
--fdec-blank-format-item -fdefault-double-8 -fdefault-integer-8 @gol
--fdefault-real-8 -fdefault-real-10 -fdefault-real-16 -fdollar-ok @gol
--ffixed-line-length-@var{n} -ffixed-line-length-none -fpad-source @gol
--ffree-form -ffree-line-length-@var{n} -ffree-line-length-none @gol
+@gccoptlist{-fall-intrinsics -fallow-invalid-boz -fbackslash -fcray-pointer @gol
+-fd-lines-as-code -fd-lines-as-comments -fdec -fdec-structure @gol
+-fdec-intrinsic-ints -fdec-static -fdec-math -fdec-include @gol
+-fdec-format-defaults -fdec-blank-format-item -fdefault-double-8 @gol
+-fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 -fdefault-real-16 @gol
+-fdollar-ok @gol -ffixed-line-length-@var{n} -ffixed-line-length-none @gol
+-fpad-source -ffree-form -ffree-line-length-@var{n} -ffree-line-length-none @gol
 -fimplicit-none -finteger-4-integer-8 -fmax-identifier-length @gol
 -fmodule-private -ffixed-form -fno-range-check -fopenacc -fopenmp @gol
 -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 -freal-8-real-10 @gol
@@ -231,6 +231,13 @@ available with @command{gfortran}.  As a consequence, @option{-Wintrinsics-std}
 will be ignored and no user-defined procedure with the same name as any
 intrinsic will be called except when it is explicitly declared @code{EXTERNAL}.
 
+@item -fallow-invalid-boz
+@opindex @code{allow-invalid-boz}
+A BOZ literal constant can occur in a limited number of context in
+standard conforming Fortran.  This option degrades an error condition
+to a warning, and allows a BOZ literal constant to appear where the
+Fortran standard would otherwise prohibits it.
+
 @item -fd-lines-as-code
 @itemx -fd-lines-as-comments
 @opindex @code{fd-lines-as-code}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 88674cb..fdf5061 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -377,6 +377,10 @@ fall-intrinsics
 Fortran RejectNegative Var(flag_all_intrinsics)
 All intrinsics procedures are available regardless of selected standard.
 
+fallow-invalid-boz
+Fortran RejectNegative Var(flag_allow_invalid_boz)
+Allow a BOZ literal constant to appear in an invalid context.
+
 fallow-leading-underscore
 Fortran Undocumented Var(flag_allow_leading_underscore)
 ; For internal use only: allow the first character of symbol names to be an underscore
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index f82fc6a..30cb6ef 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -174,6 +174,6 @@ typedef enum
 typedef enum
 { BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
   BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
-  BT_ASSUMED, BT_UNION
+  BT_ASSUMED, BT_UNION, BT_BOZ
 }
 bt;
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index ec31fb9..2569f6b 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -100,6 +100,9 @@ gfc_basic_typename (bt type)
     case BT_VOID:
       p = "VOID";
       break;
+    case BT_BOZ:
+      p = "BOZ";
+      break;
     case BT_UNKNOWN:
       p = "UNKNOWN";
       break;
@@ -169,6 +172,9 @@ gfc_typename (gfc_typespec *ts)
     case BT_PROCEDURE:
       strcpy (buffer, "PROCEDURE");
       break;
+    case BT_BOZ:
+      strcpy (buffer, "BOZ");
+      break;
     case BT_UNKNOWN:
       strcpy (buffer, "UNKNOWN");
       break;
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index e918372..da524e9 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -189,6 +189,55 @@ match_digits (int signflag, int radix, char *buffer)
   return length;
 }
 
+/* Convert an integer string to an expression node.  */
+
+static gfc_expr *
+convert_integer (const char *buffer, int kind, int radix, locus *where)
+{
+  gfc_expr *e;
+  const char *t;
+
+  e = gfc_get_constant_expr (BT_INTEGER, kind, where);
+  /* A leading plus is allowed, but not by mpz_set_str.  */
+  if (buffer[0] == '+')
+    t = buffer + 1;
+  else
+    t = buffer;
+  mpz_set_str (e->value.integer, t, radix);
+
+  return e;
+}
+
+
+/* Convert a real string to an expression node.  */
+
+static gfc_expr *
+convert_real (const char *buffer, int kind, locus *where)
+{
+  gfc_expr *e;
+
+  e = gfc_get_constant_expr (BT_REAL, kind, where);
+  mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
+
+  return e;
+}
+
+
+/* Convert a pair of real, constant expression nodes to a single
+   complex expression node.  */
+
+static gfc_expr *
+convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
+{
+  gfc_expr *e;
+
+  e = gfc_get_constant_expr (BT_COMPLEX, kind, &real->where);
+  mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
+		 GFC_MPC_RND_MODE);
+
+  return e;
+}
+
 
 /* Match an integer (digit string and optional kind).
    A sign will be accepted if signflag is set.  */
@@ -231,7 +280,7 @@ match_integer_constant (gfc_expr **result, int signflag)
       return MATCH_ERROR;
     }
 
-  e = gfc_convert_integer (buffer, kind, 10, &gfc_current_locus);
+  e = convert_integer (buffer, kind, 10, &gfc_current_locus);
   e->ts.is_c_interop = is_iso_c;
 
   if (gfc_range_check (e) != ARITH_OK)
@@ -337,7 +386,7 @@ cleanup:
 static match
 match_boz_constant (gfc_expr **result)
 {
-  int radix, length, x_hex, kind;
+  int radix, length, x_hex;
   locus old_loc, start_loc;
   char *buffer, post, delim;
   gfc_expr *e;
@@ -383,9 +432,9 @@ match_boz_constant (gfc_expr **result)
     goto backup;
 
   if (x_hex
-      && (!gfc_notify_std(GFC_STD_GNU, "Hexadecimal "
-			  "constant at %C uses non-standard syntax")))
-      return MATCH_ERROR;
+      && gfc_invalid_boz ("Hexadecimal constant at %L uses "
+			  "nonstandard syntax", &gfc_current_locus))
+    return MATCH_ERROR;
 
   old_loc = gfc_current_locus;
 
@@ -421,8 +470,8 @@ match_boz_constant (gfc_expr **result)
 	  goto backup;
 	}
 
-      if (!gfc_notify_std (GFC_STD_GNU, "BOZ constant "
-			   "at %C uses non-standard postfix syntax"))
+      if (gfc_invalid_boz ("BOZ constant at %C uses nonstandard postfix "
+			   "syntax", &gfc_current_locus))
 	return MATCH_ERROR;
     }
 
@@ -436,30 +485,20 @@ match_boz_constant (gfc_expr **result)
   if (post == 1)
     gfc_next_ascii_char ();  /* Eat postfixed b, o, z, or x.  */
 
-  /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find
-     "If a data-stmt-constant is a boz-literal-constant, the corresponding
-     variable shall be of type integer.  The boz-literal-constant is treated
-     as if it were an int-literal-constant with a kind-param that specifies
-     the representation method with the largest decimal exponent range
-     supported by the processor."  */
-
-  kind = gfc_max_integer_kind;
-  e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
-
-  /* Mark as boz variable.  */
-  e->is_boz = 1;
-
-  if (gfc_range_check (e) != ARITH_OK)
-    {
-      gfc_error ("Integer too big for integer kind %i at %C", kind);
-      gfc_free_expr (e);
-      return MATCH_ERROR;
-    }
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_CONSTANT;
+  e->ts.type = BT_BOZ;
+  e->where = gfc_current_locus;
+  e->boz.rdx = radix;
+  e->boz.len = length;
+  e->boz.str = XCNEWVEC (char, length + 1);
+  strncpy (e->boz.str, buffer, length);
 
+  /* FIXME BOZ.  */
   if (!gfc_in_match_data ()
       && (!gfc_notify_std(GFC_STD_F2003, "BOZ used outside a DATA "
-			  "statement at %C")))
-      return MATCH_ERROR;
+			  "statement at %L", &e->where)))
+    return MATCH_ERROR;
 
   *result = e;
   return MATCH_YES;
@@ -715,7 +754,7 @@ done:
 	}
     }
 
-  e = gfc_convert_real (buffer, kind, &gfc_current_locus);
+  e = convert_real (buffer, kind, &gfc_current_locus);
   if (negate)
     mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE);
   e->ts.is_c_interop = is_iso_c;
@@ -1433,7 +1472,7 @@ match_complex_constant (gfc_expr **result)
   if (imag->ts.type != BT_REAL || kind != imag->ts.kind)
     gfc_convert_type (imag, &target, 2);
 
-  e = gfc_convert_complex (real, imag, kind);
+  e = convert_complex (real, imag, kind);
   e->where = gfc_current_locus;
 
   gfc_free_expr (real);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c82e8f2..70c7f82 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10473,44 +10473,32 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   lhs = code->expr1;
   rhs = code->expr2;
 
-  if (rhs->is_boz
-      && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
-			  "a DATA statement and outside INT/REAL/DBLE/CMPLX",
-			  &code->loc))
-    return false;
-
   /* Handle the case of a BOZ literal on the RHS.  */
-  if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
+  if (rhs->ts.type == BT_BOZ)
     {
-      int rc;
-      if (warn_surprising)
-	gfc_warning (OPT_Wsurprising,
-		     "BOZ literal at %L is bitwise transferred "
-		     "non-integer symbol %qs", &code->loc,
-		     lhs->symtree->n.sym->name);
-
-      if (!gfc_convert_boz (rhs, &lhs->ts))
+      if (gfc_invalid_boz ("BOZ literal constant at %L is neither a DATA "
+			   "statement value nor an actual argument of "
+			   "INT/REAL/DBLE/CMPLX intrinsic subprogram",
+			   &rhs->where))
 	return false;
-      if ((rc = gfc_range_check (rhs)) != ARITH_OK)
-	{
-	  if (rc == ARITH_UNDERFLOW)
-	    gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rhs->where);
-	  else if (rc == ARITH_OVERFLOW)
-	    gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rhs->where);
-	  else if (rc == ARITH_NAN)
-	    gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
-		       ". This check can be disabled with the option "
-		       "%<-fno-range-check%>", &rhs->where);
+
+      switch (lhs->ts.type)
+	{
+	case BT_INTEGER:
+	  if (!gfc_boz2int (rhs, lhs->ts.kind))
+	    return false;
+	  break;
+	case BT_REAL:
+	  if (!gfc_boz2real (rhs, lhs->ts.kind))
+	    return false;
+	  break;
+	default:
+	  gfc_error ("Invalid use of BOZ literal constant at %L", &rhs->where);
 	  return false;
 	}
     }
 
-  if (lhs->ts.type == BT_CHARACTER
-	&& warn_character_truncation)
+  if (lhs->ts.type == BT_CHARACTER && warn_character_truncation)
     {
       HOST_WIDE_INT llen = 0, rlen = 0;
       if (lhs->ts.u.cl != NULL
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 2d20913..5ab7c81 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -211,26 +211,6 @@ gfc_convert_mpz_to_signed (mpz_t x, int bitsize)
 }
 
 
-/* In-place convert BOZ to REAL of the specified kind.  */
-
-static gfc_expr *
-convert_boz (gfc_expr *x, int kind)
-{
-  if (x && x->ts.type == BT_INTEGER && x->is_boz)
-    {
-      gfc_typespec ts;
-      gfc_clear_ts (&ts);
-      ts.type = BT_REAL;
-      ts.kind = kind;
-
-      if (!gfc_convert_boz (x, &ts))
-	return &gfc_bad_expr;
-    }
-
-  return x;
-}
-
-
 /* Test that the expression is a constant array, simplifying if
    we are dealing with a parameter array.  */
 
@@ -1660,12 +1640,6 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
 {
   gfc_expr *result;
 
-  if (convert_boz (x, kind) == &gfc_bad_expr)
-    return &gfc_bad_expr;
-
-  if (convert_boz (y, kind) == &gfc_bad_expr)
-    return &gfc_bad_expr;
-
   if (x->expr_type != EXPR_CONSTANT
       || (y != NULL && y->expr_type != EXPR_CONSTANT))
     return NULL;
@@ -2219,9 +2193,6 @@ gfc_simplify_dble (gfc_expr *e)
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (convert_boz (e, gfc_default_double_kind) == &gfc_bad_expr)
-    return &gfc_bad_expr;
-
   result = gfc_convert_constant (e, BT_REAL, gfc_default_double_kind);
   if (result == &gfc_bad_expr)
     return &gfc_bad_expr;
@@ -2965,15 +2936,7 @@ gfc_simplify_float (gfc_expr *a)
   if (a->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (a->is_boz)
-    {
-      if (convert_boz (a, gfc_default_real_kind) == &gfc_bad_expr)
-	return &gfc_bad_expr;
-
-      result = gfc_copy_expr (a);
-    }
-  else
-    result = gfc_int2real (a, gfc_default_real_kind);
+  result = gfc_int2real (a, gfc_default_real_kind);
 
   return range_check (result, "FLOAT");
 }
@@ -3610,6 +3573,15 @@ simplify_intconv (gfc_expr *e, int kind, const char *name)
 {
   gfc_expr *result = NULL;
 
+  /* Convert BOZ to integer, and return without range checking.  */
+  if (e->ts.type == BT_BOZ)
+    {
+      if (!gfc_boz2int (e, kind))
+	return NULL;
+      result = gfc_copy_expr (e);
+      return result;
+    }
+
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
@@ -6497,6 +6469,21 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
   gfc_expr *result = NULL;
   int kind;
 
+  /* Convert BOZ to real, and return without range checking.  */
+  if (e->ts.type == BT_BOZ)
+    {
+      /* Determine kind for conversion of the BOZ.  */
+      if (k)
+	gfc_extract_int (k, &kind);
+      else
+	kind = gfc_default_real_kind;
+
+      if (!gfc_boz2real (e, kind))
+	return NULL;
+      result = gfc_copy_expr (e);
+      return result;
+    }
+
   if (e->ts.type == BT_COMPLEX)
     kind = get_kind (BT_REAL, k, "REAL", e->ts.kind);
   else
@@ -6508,9 +6495,6 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (convert_boz (e, kind) == &gfc_bad_expr)
-    return &gfc_bad_expr;
-
   result = gfc_convert_constant (e, BT_REAL, kind);
   if (result == &gfc_bad_expr)
     return &gfc_bad_expr;
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 1354c57..1b23a44 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -769,35 +769,19 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
   int index;
   unsigned char *buffer;
 
-  if (!expr->is_boz)
+  if (expr->ts.type != BT_INTEGER)
     return true;
 
-  gcc_assert (expr->expr_type == EXPR_CONSTANT
-	      && expr->ts.type == BT_INTEGER);
-
   /* Don't convert BOZ to logical, character, derived etc.  */
-  if (ts->type == BT_REAL)
-    {
-      buffer_size = size_float (ts->kind);
-      ts_bit_size = buffer_size * 8;
-    }
-  else if (ts->type == BT_COMPLEX)
-    {
-      buffer_size = size_complex (ts->kind);
-      ts_bit_size = buffer_size * 8 / 2;
-    }
-  else
-    return true;
+  gcc_assert (ts->type == BT_REAL);
+
+  buffer_size = size_float (ts->kind);
+  ts_bit_size = buffer_size * 8;
 
   /* Convert BOZ to the smallest possible integer kind.  */
   boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
 
-  if (boz_bit_size > ts_bit_size)
-    {
-      gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
-		     &expr->where, (long) boz_bit_size, (long) ts_bit_size);
-      return false;
-    }
+  gcc_assert (boz_bit_size <= ts_bit_size);
 
   for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
     if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
@@ -810,18 +794,9 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
   encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
   mpz_clear (expr->value.integer);
 
-  if (ts->type == BT_REAL)
-    {
-      mpfr_init (expr->value.real);
-      gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
-    }
-  else
-    {
-      mpc_init2 (expr->value.complex, mpfr_get_default_prec());
-      gfc_interpret_complex (ts->kind, buffer, buffer_size,
-			     expr->value.complex);
-    }
-  expr->is_boz = 0;
+  mpfr_init (expr->value.real);
+  gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
+
   expr->ts.type = ts->type;
   expr->ts.kind = ts->kind;