Blob Blame History Raw
From f883ac209b0feea860354cb4ef7ff06dc8063fab Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Fri, 22 Jan 2021 12:53:35 +0000
Subject: [PATCH 03/10] Allow more than one character as argument to ICHAR

Use -fdec to enable.
---
 gcc/fortran/check.c                           |  2 +-
 gcc/fortran/simplify.c                        |  4 ++--
 .../gfortran.dg/dec_ichar_with_string_1.f     | 21 +++++++++++++++++++
 3 files changed, 24 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..623c1cc470e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3157,7 +3157,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
   else
     return true;
 
-  if (i != 1)
+  if (i != 1 && !flag_dec)
     {
       gfc_error ("Argument of %s at %L must be of length one",
 		 gfc_current_intrinsic, &c->where);
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 23317a2e2d9..9900572424f 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3261,7 +3261,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (e->value.character.length != 1)
+  if (e->value.character.length != 1 && !flag_dec)
     {
       gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
       return &gfc_bad_expr;
@@ -3459,7 +3459,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (e->value.character.length != 1)
+  if (e->value.character.length != 1 && !flag_dec)
     {
       gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
       return &gfc_bad_expr;
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
new file mode 100644
index 00000000000..85efccecc0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test ICHAR and IACHAR with more than one character as argument
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+        PROGRAM ichar_more_than_one_character
+          CHARACTER*4 st/'Test'/
+          INTEGER i
+
+          i = ICHAR(st)
+          if (i.NE.84) STOP 1
+          i = IACHAR(st)
+          if (i.NE.84) STOP 2
+          i = ICHAR('Test')
+          if (i.NE.84) STOP 3
+          i = IACHAR('Test')
+          if (i.NE.84) STOP 4
+        END
-- 
2.27.0