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