|
 |
3db796 |
From d75972937274489189a151a47da9b9aadfdefe8d Mon Sep 17 00:00:00 2001
|
|
|
3db796 |
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
3db796 |
Date: Mon, 5 Oct 2015 13:45:15 +0100
|
|
|
3db796 |
Subject: [PATCH 07/23] Allow more than one character as argument to ICHAR
|
|
|
3db796 |
|
|
|
3db796 |
This feature is enabled by the `-std=extra-legacy` compiler flag.
|
|
|
3db796 |
---
|
|
|
3db796 |
|
|
|
6068c7 |
commit 44861a8907c8d849193287231a464d34fcce522d
|
|
|
6068c7 |
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
6068c7 |
Date: Mon Oct 5 13:45:15 2015 +0100
|
|
|
6068c7 |
|
|
|
6068c7 |
Allow more than one character as argument to ICHAR
|
|
|
6068c7 |
|
|
|
6068c7 |
This feature is enabled by the `-std=extra-legacy` compiler flag.
|
|
|
6068c7 |
|
|
|
6068c7 |
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
|
3db796 |
|
|
|
3db796 |
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
|
|
|
6068c7 |
index 4f2d21610b9..38a90519c81 100644
|
|
|
3db796 |
--- a/gcc/fortran/check.c
|
|
|
3db796 |
+++ b/gcc/fortran/check.c
|
|
|
6068c7 |
@@ -2472,7 +2472,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
|
|
|
3db796 |
else
|
|
|
3db796 |
return true;
|
|
|
3db796 |
|
|
|
3db796 |
- if (i != 1)
|
|
|
3db796 |
+ if (i != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
|
|
|
3db796 |
{
|
|
|
3db796 |
gfc_error ("Argument of %s at %L must be of length one",
|
|
|
3db796 |
gfc_current_intrinsic, &c->where);
|
|
|
3db796 |
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
|
|
|
6068c7 |
index 80c96371ad9..6e05bb444ed 100644
|
|
|
3db796 |
--- a/gcc/fortran/simplify.c
|
|
|
3db796 |
+++ b/gcc/fortran/simplify.c
|
|
|
3db796 |
@@ -2774,7 +2774,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
|
|
|
3db796 |
if (e->expr_type != EXPR_CONSTANT)
|
|
|
3db796 |
return NULL;
|
|
|
3db796 |
|
|
|
3db796 |
- if (e->value.character.length != 1)
|
|
|
3db796 |
+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
|
|
|
3db796 |
{
|
|
|
3db796 |
gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
|
|
|
3db796 |
return &gfc_bad_expr;
|
|
|
3db796 |
@@ -2972,7 +2972,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
|
|
|
3db796 |
if (e->expr_type != EXPR_CONSTANT)
|
|
|
3db796 |
return NULL;
|
|
|
3db796 |
|
|
|
3db796 |
- if (e->value.character.length != 1)
|
|
|
3db796 |
+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
|
|
|
3db796 |
{
|
|
|
3db796 |
gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
|
|
|
3db796 |
return &gfc_bad_expr;
|
|
|
6068c7 |
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f
|
|
|
6068c7 |
new file mode 100644
|
|
|
6068c7 |
index 00000000000..c97746d4a4e
|
|
|
6068c7 |
--- /dev/null
|
|
|
6068c7 |
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f
|
|
|
6068c7 |
@@ -0,0 +1,18 @@
|
|
|
6068c7 |
+! { dg-do compile }
|
|
|
6068c7 |
+! { dg-options "-std=extra-legacy" }
|
|
|
6068c7 |
+!
|
|
|
6068c7 |
+! Test ICHAR and IACHAR with more than one character as argument
|
|
|
6068c7 |
+!
|
|
|
6068c7 |
+ PROGRAM ichar_more_than_one_character
|
|
|
6068c7 |
+ CHARACTER*4 st/'Test'/
|
|
|
6068c7 |
+ INTEGER i
|
|
|
6068c7 |
+
|
|
|
6068c7 |
+ i = ICHAR(st)
|
|
|
6068c7 |
+ if (i.NE.84) STOP 1
|
|
|
6068c7 |
+ i = IACHAR(st)
|
|
|
6068c7 |
+ if (i.NE.84) STOP 2
|
|
|
6068c7 |
+ i = ICHAR('Test')
|
|
|
6068c7 |
+ if (i.NE.84) STOP 3
|
|
|
6068c7 |
+ i = IACHAR('Test')
|
|
|
6068c7 |
+ if (i.NE.84) STOP 4
|
|
|
6068c7 |
+ END
|