From c1d6c81730ffda61eff8fccf4d0c7efa3ae6fd8d Mon Sep 17 00:00:00 2001

From: Jim MacArthur <jim.macarthur@codethink.co.uk>

Date: Thu, 4 Feb 2016 17:18:30 +0000

Subject: [PATCH 04/16] Allow CHARACTER literals in assignments and data

 statements

Warnings are raised when this happens.

Enable using -fdec-char-as-int or -fdec

---

 gcc/fortran/arith.c                                | 96 +++++++++++++++++++++-

 gcc/fortran/arith.h                                |  4 +

 gcc/fortran/expr.c                                 |  5 ++

 gcc/fortran/intrinsic.c                            | 32 +++++++-

 gcc/fortran/lang.opt                               |  5 ++

 gcc/fortran/options.c                              |  1 +

 gcc/fortran/resolve.c                              | 11 ++-

 gcc/fortran/simplify.c                             | 29 ++++++-

 gcc/fortran/trans-const.c                          |  3 +-

 .../dec_char_conversion_in_assignment_1.f90        | 61 ++++++++++++++

 .../dec_char_conversion_in_assignment_2.f90        | 61 ++++++++++++++

 .../dec_char_conversion_in_assignment_3.f90        | 61 ++++++++++++++

 .../gfortran.dg/dec_char_conversion_in_data_1.f90  | 69 ++++++++++++++++

 .../gfortran.dg/dec_char_conversion_in_data_2.f90  | 69 ++++++++++++++++

 .../gfortran.dg/dec_char_conversion_in_data_3.f90  | 69 ++++++++++++++++

 gcc/testsuite/gfortran.dg/hollerith5.f90           |  5 +-

 gcc/testsuite/gfortran.dg/hollerith_legacy.f90     |  2 +-

 .../gfortran.dg/no_char_to_int_assign.f90          | 20 +++++

 18 files changed, 589 insertions(+), 14 deletions(-)

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90

 create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90

 create mode 100644 gcc/testsuite/gfortran.dg/no_char_to_int_assign.f90

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c

index f2d311c044c..7e6d6dd3bb8 100644

--- a/gcc/fortran/arith.c

+++ b/gcc/fortran/arith.c

@@ -2553,11 +2553,11 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)

   src_len = src->representation.length - src->ts.u.pad;

   gfc_target_expr_size (result, &result_len);

-  if (src_len > result_len)

+  if (src_len > result_len && warn_character_truncation)

     {

-      gfc_warning (0,

-		   "The Hollerith constant at %L is too long to convert to %qs",

-		   &src->where, gfc_typename(&result->ts));

+      gfc_warning (OPT_Wcharacter_truncation, "The Hollerith constant at %L "

+		   "is truncated in conversion to %qs", &src->where,

+		   gfc_typename(&result->ts));

     }

   result->representation.string = XCNEWVEC (char, result_len + 1);

@@ -2572,6 +2572,36 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)

 }

+/* Helper function to set the representation in a character conversion.

+   This assumes that the ts.type and ts.kind of the result have already

+   been set.  */

+

+static void

+character2representation (gfc_expr *result, gfc_expr *src)

+{

+  size_t src_len, result_len;

+  int i;

+  src_len = src->value.character.length;

+  gfc_target_expr_size (result, &result_len);

+

+  if (src_len > result_len && warn_character_truncation)

+    gfc_warning (OPT_Wcharacter_truncation, "The character constant at %L is "

+		 "is truncated in conversion to %s", &src->where,

+		 gfc_typename(&result->ts));

+

+  result->representation.string = XCNEWVEC (char, result_len + 1);

+

+  for (i = 0; i < MIN (result_len, src_len); i++)

+    result->representation.string[i] = (char) src->value.character.string[i];

+

+  if (src_len < result_len)

+    memset (&result->representation.string[src_len], ' ',

+	    result_len - src_len);

+

+  result->representation.string[result_len] = '\0'; /* For debugger  */

+  result->representation.length = result_len;

+}

+

 /* Convert Hollerith to integer. The constant will be padded or truncated.  */

 gfc_expr *

@@ -2587,6 +2617,19 @@ gfc_hollerith2int (gfc_expr *src, int kind)

   return result;

 }

+/* Convert character to integer. The constant will be padded or truncated. */

+

+gfc_expr *

+gfc_character2int (gfc_expr *src, int kind)

+{

+  gfc_expr *result;

+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);

+

+  character2representation (result, src);

+  gfc_interpret_integer (kind, (unsigned char *) result->representation.string,

+			 result->representation.length, result->value.integer);

+  return result;

+}

 /* Convert Hollerith to real. The constant will be padded or truncated.  */

@@ -2603,6 +2646,21 @@ gfc_hollerith2real (gfc_expr *src, int kind)

   return result;

 }

+/* Convert character to real. The constant will be padded or truncated.  */

+

+gfc_expr *

+gfc_character2real (gfc_expr *src, int kind)

+{

+  gfc_expr *result;

+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);

+

+  character2representation (result, src);

+  gfc_interpret_float (kind, (unsigned char *) result->representation.string,

+		       result->representation.length, result->value.real);

+

+  return result;

+}

+

 /* Convert Hollerith to complex. The constant will be padded or truncated.  */

@@ -2619,6 +2677,21 @@ gfc_hollerith2complex (gfc_expr *src, int kind)

   return result;

 }

+/* Convert character to complex. The constant will be padded or truncated.  */

+

+gfc_expr *

+gfc_character2complex (gfc_expr *src, int kind)

+{

+  gfc_expr *result;

+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);

+

+  character2representation (result, src);

+  gfc_interpret_complex (kind, (unsigned char *) result->representation.string,

+			 result->representation.length, result->value.complex);

+

+  return result;

+}

+

 /* Convert Hollerith to character.  */

@@ -2654,3 +2727,18 @@ gfc_hollerith2logical (gfc_expr *src, int kind)

   return result;

 }

+

+/* Convert character to logical. The constant will be padded or truncated.  */

+

+gfc_expr *

+gfc_character2logical (gfc_expr *src, int kind)

+{

+  gfc_expr *result;

+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);

+

+  character2representation (result, src);

+  gfc_interpret_logical (kind, (unsigned char *) result->representation.string,

+			 result->representation.length, &result->value.logical);

+

+  return result;

+}

diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h

index e06c7059885..13ffd8d0b6c 100644

--- a/gcc/fortran/arith.h

+++ b/gcc/fortran/arith.h

@@ -82,7 +82,11 @@ gfc_expr *gfc_hollerith2real (gfc_expr *, int);

 gfc_expr *gfc_hollerith2complex (gfc_expr *, int);

 gfc_expr *gfc_hollerith2character (gfc_expr *, int);

 gfc_expr *gfc_hollerith2logical (gfc_expr *, int);

+gfc_expr *gfc_character2int (gfc_expr *, int);

+gfc_expr *gfc_character2real (gfc_expr *, int);

+gfc_expr *gfc_character2complex (gfc_expr *, int);

 gfc_expr *gfc_character2character (gfc_expr *, int);

+gfc_expr *gfc_character2logical (gfc_expr *, int);

 #endif /* GFC_ARITH_H  */

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c

index 474e9ecc401..77600a5f2e8 100644

--- a/gcc/fortran/expr.c

+++ b/gcc/fortran/expr.c

@@ -3695,6 +3695,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,

 	  || rvalue->ts.type == BT_HOLLERITH)

 	return true;

+      if (flag_dec_char_conversions && (gfc_numeric_ts (&lvalue->ts)

+	  || lvalue->ts.type == BT_LOGICAL)     

+          && rvalue->ts.type == BT_CHARACTER)

+	return true;

+

       if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)

 	return true;

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c

index c21fbddd5fb..e94d5d3225f 100644

--- a/gcc/fortran/intrinsic.c

+++ b/gcc/fortran/intrinsic.c

@@ -4017,6 +4017,28 @@ add_conversions (void)

 	  add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,

 		    BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);

 	}

+

+  /* Flang allows character conversions similar to Hollerith conversions

+     - the first characters will be turned into ascii values. */

+  if (flag_dec_char_conversions)

+    {

+      /* Character-Integer conversions.  */

+      for (i = 0; gfc_integer_kinds[i].kind != 0; i++)

+	add_conv (BT_CHARACTER, gfc_default_character_kind,

+		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);

+      /* Character-Real conversions.  */

+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)

+	add_conv (BT_CHARACTER, gfc_default_character_kind,

+		  BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);

+      /* Character-Complex conversions.  */

+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)

+	add_conv (BT_CHARACTER, gfc_default_character_kind,

+		  BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);

+      /* Character-Logical conversions.  */

+      for (i = 0; gfc_logical_kinds[i].kind != 0; i++)

+	add_conv (BT_CHARACTER, gfc_default_character_kind,

+		  BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);

+    }

 }

@@ -5128,8 +5150,16 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)

 			     gfc_typename (&from_ts), gfc_typename (ts),

 			     &expr->where);

 	}

+      else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER

+	       && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))

+	{

+	  if (warn_conversion)

+	    gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",

+			     gfc_typename (&from_ts), gfc_typename (ts),

+			     &expr->where);

+	}

       else

-        gcc_unreachable ();

+	gcc_unreachable ();

     }

   /* Insert a pre-resolved function call to the right function.  */

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt

index 13a8e9778bb..5746b99b1d4 100644

--- a/gcc/fortran/lang.opt

+++ b/gcc/fortran/lang.opt

@@ -444,6 +444,11 @@ fdec-duplicates

 Fortran Var(flag_dec_duplicates)

 Allow varibles to be duplicated in the type specification matches.

+fdec-char-conversions

+Fortran Var(flag_dec_char_conversions)

+Enable the use of character literals in assignments and data statements

+for non-character variables.

+

 fdec-include

 Fortran Var(flag_dec_include)

 Enable legacy parsing of INCLUDE as statement.

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c

index f93db8b6d7c..e97b1568810 100644

--- a/gcc/fortran/options.c

+++ b/gcc/fortran/options.c

@@ -76,6 +76,7 @@ set_dec_flags (int value)

   SET_BITFLAG (flag_dec_include, value, value);

   SET_BITFLAG (flag_dec_format_defaults, value, value);

   SET_BITFLAG (flag_dec_duplicates, value, value);

+  SET_BITFLAG (flag_dec_char_conversions, value, value);

 }

 /* Finalize DEC flags.  */

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c

index 32b8d504ff6..43559185481 100644

--- a/gcc/fortran/resolve.c

+++ b/gcc/fortran/resolve.c

@@ -4320,7 +4320,6 @@ bad_op:

   return false;

 }

-

 /************** Array resolution subroutines **************/

 enum compare_result

@@ -10498,6 +10497,16 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)

   lhs = code->expr1;

   rhs = code->expr2;

+  if ((gfc_numeric_ts (&lhs->ts) || lhs->ts.type == BT_LOGICAL)

+      && rhs->ts.type == BT_CHARACTER

+      && rhs->expr_type != EXPR_CONSTANT)

+    {

+      gfc_error ("Cannot convert CHARACTER into %s at %L",

+                 gfc_typename (&lhs->ts),     

+                 &rhs->where);

+      return false;

+    }

+

   if (rhs->is_boz

       && !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "

 			  "a DATA statement and outside INT/REAL/DBLE/CMPLX",

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c

index 6c1f4bd4fce..7d7e3f22f73 100644

--- a/gcc/fortran/simplify.c

+++ b/gcc/fortran/simplify.c

@@ -8457,10 +8457,31 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)

       break;

     case BT_CHARACTER:

-      if (type == BT_CHARACTER)

-	f = gfc_character2character;

-      else

-	goto oops;

+      switch (type)

+	{

+	case BT_INTEGER:

+	  f = gfc_character2int;

+	  break;

+

+	case BT_REAL:

+	  f = gfc_character2real;

+	  break;

+

+	case BT_COMPLEX:

+	  f = gfc_character2complex;

+	  break;

+

+	case BT_CHARACTER:

+	  f = gfc_character2character;

+	  break;

+

+	case BT_LOGICAL:

+	  f = gfc_character2logical;

+	  break;

+

+	default:

+	  goto oops;

+	}

       break;

     default:

diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c

index 432d12bf168..b155e35cbdd 100644

--- a/gcc/fortran/trans-const.c

+++ b/gcc/fortran/trans-const.c

@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see

 #include "coretypes.h"

 #include "tree.h"

 #include "gfortran.h"

+#include "options.h"

 #include "trans.h"

 #include "fold-const.h"

 #include "stor-layout.h"

@@ -330,7 +331,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr)

 			gfc_get_int_type (expr->ts.kind),

 			gfc_build_string_const (expr->representation.length,

 						expr->representation.string));

-	  if (!integer_zerop (tmp) && !integer_onep (tmp))

+	  if (!integer_zerop (tmp) && !integer_onep (tmp) && warn_surprising)

 	    gfc_warning (0, "Assigning value other than 0 or 1 to LOGICAL"

 			 " has undefined result at %L", &expr->where);

 	  return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);

diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90

new file mode 100644

index 00000000000..d504f92fbbc

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90

@@ -0,0 +1,61 @@

+! { dg-do run }

+! { dg-options "-fdec -Wsurprising -Wcharacter-truncation" }

+!

+! Modified by Mark Eggleston <mark.eggleston@codethink.com>

+!

+program test

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  a = '1234'

+  b = '1234'

+  c = '12341234'

+  d = '1234'     ! { dg-warning "undefined result" }

+  e = 4h1234

+  f = 4h1234

+  g = 8h12341234

+  h = 4h1234     ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 1

+  if (b.ne.f) stop 2

+  if (c.ne.g) stop 3

+  if (d.neqv.h) stop 4

+

+  ! padded values

+  a = '12'

+  b = '12'

+  c = '12234'

+  d = '124'   ! { dg-warning "undefined result" }

+  e = 2h12

+  f = 2h12

+  g = 5h12234

+  h = 3h123   ! { dg-warning "undefined result" }

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+  ! truncated values

+  a = '123478'       ! { dg-warning "truncated in" }

+  b = '123478'       ! { dg-warning "truncated in" }

+  c = '12341234987'  ! { dg-warning "truncated in" }

+  d = '1234abc'      ! { dg-warning "truncated in|undefined result" }

+  e = 6h123478       ! { dg-warning "truncated in" }

+  f = 6h123478       ! { dg-warning "truncated in" }

+  g = 11h12341234987 ! { dg-warning "truncated in" }

+  h = 7h1234abc      ! { dg-warning "truncated in|undefined result" }

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+end program

+

diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90

new file mode 100644

index 00000000000..737ddc664de

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90

@@ -0,0 +1,61 @@

+! { dg-do run }

+! { dg-options "-fdec-char-conversions -std=legacy -Wcharacter-truncation -Wsurprising" }

+!

+! Modified by Mark Eggleston <mark.eggleston@codethink.com>

+!

+program test

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  a = '1234'

+  b = '1234'

+  c = '12341234'

+  d = '1234'     ! { dg-warning "undefined result" }

+  e = 4h1234

+  f = 4h1234

+  g = 8h12341234

+  h = 4h1234     ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 1

+  if (b.ne.f) stop 2

+  if (c.ne.g) stop 3

+  if (d.neqv.h) stop 4

+

+  ! padded values

+  a = '12'

+  b = '12'

+  c = '12234'

+  d = '124'   ! { dg-warning "undefined result" }

+  e = 2h12

+  f = 2h12

+  g = 5h12234

+  h = 3h123   ! { dg-warning "undefined result" }

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+  ! truncated values

+  a = '123478'       ! { dg-warning "truncated in" }

+  b = '123478'       ! { dg-warning "truncated in" }

+  c = '12341234987'  ! { dg-warning "truncated in" }

+  d = '1234abc'      ! { dg-warning "truncated in|undefined result" }

+  e = 6h123478       ! { dg-warning "truncated in" }

+  f = 6h123478       ! { dg-warning "truncated in" }

+  g = 11h12341234987 ! { dg-warning "truncated in" }

+  h = 7h1234abc      ! { dg-warning "truncated in|undefined result" }

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+end program

+

diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90

new file mode 100644

index 00000000000..0ec494c4a92

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90

@@ -0,0 +1,61 @@

+! { dg-do compile }

+! { dg-options "-fdec -fno-dec-char-conversions" }

+!

+! Modified by Mark Eggleston <mark.eggleston@codethink.com>

+!

+program test

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  a = '1234'     ! { dg-error "Cannot convert" }

+  b = '1234'     ! { dg-error "Cannot convert" }

+  c = '12341234' ! { dg-error "Cannot convert" }

+  d = '1234'     ! { dg-error "Cannot convert" }

+  e = 4h1234

+  f = 4h1234

+  g = 8h12341234

+  h = 4h1234

+  

+  if (a.ne.e) stop 1

+  if (b.ne.f) stop 2

+  if (c.ne.g) stop 3

+  if (d.neqv.h) stop 4

+

+  ! padded values

+  a = '12'    ! { dg-error "Cannot convert" }

+  b = '12'    ! { dg-error "Cannot convert" }

+  c = '12234' ! { dg-error "Cannot convert" }

+  d = '124'   ! { dg-error "Cannot convert" }

+  e = 2h12

+  f = 2h12

+  g = 5h12234

+  h = 3h123

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+  ! truncated values

+  a = '123478'       ! { dg-error "Cannot convert" }

+  b = '123478'       ! { dg-error "Cannot convert" }

+  c = '12341234987'  ! { dg-error "Cannot convert" }

+  d = '1234abc'      ! { dg-error "Cannot convert" }

+  e = 6h123478       !

+  f = 6h123478       !

+  g = 11h12341234987 !

+  h = 7h1234abc      !

+

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+

+end program

+

diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90

new file mode 100644

index 00000000000..c493be9314b

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90

@@ -0,0 +1,69 @@

+! { dg-do run }

+! { dg-options "-fdec -Wsurprising" }

+!

+! Modified by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+subroutine normal

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" }

+  data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 1

+  if (b.ne.f) stop 2

+  if (c.ne.g) stop 3

+  if (d.neqv.h) stop 4

+end subroutine

+

+subroutine padded

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" }

+  data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+end subroutine

+

+subroutine truncated

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '123478', '123478', '1234123498', '12345' /  ! { dg-warning "too long|undefined result" }

+  data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" }

+  

+  if (a.ne.e) stop 9

+  if (b.ne.f) stop 10

+  if (c.ne.g) stop 11

+  if (d.neqv.h) stop 12

+end subroutine

+

+program test

+  call normal

+  call padded

+  call truncated

+end program

+

diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90

new file mode 100644

index 00000000000..c7d8e241cec

--- /dev/null

+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90

@@ -0,0 +1,69 @@

+! { dg-do run }

+! { dg-options "-fdec-char-conversions -std=legacy -Wsurprising" }

+!

+! Modified by Mark Eggleston <mark.eggleston@codethink.com>

+!

+

+subroutine normal

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" }

+  data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 1

+  if (b.ne.f) stop 2

+  if (c.ne.g) stop 3

+  if (d.neqv.h) stop 4

+end subroutine

+

+subroutine padded

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" }

+  data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" }

+  

+  if (a.ne.e) stop 5

+  if (b.ne.f) stop 6

+  if (c.ne.g) stop 7

+  if (d.neqv.h) stop 8

+end subroutine

+

+subroutine truncated

+  integer(4) :: a

+  real(4) :: b

+  complex(4) :: c

+  logical(4) :: d

+  integer(4) :: e

+  real(4) :: f

+  complex(4) :: g

+  logical(4) :: h

+

+  data a, b, c, d / '123478', '123478', '1234123498', '12345' /  ! { dg-warning "too long|undefined result" }

+  data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" }

+  

+  if (a.ne.e) stop 9

+  if (b.ne.f) stop 10

+  if (c.ne.g) stop 11