From 3c19e5e1a18fa59dd69c1a21e17619f6166c963e Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 7 Apr 2007 20:29:13 +0000 Subject: [PATCH] re PR fortran/31257 (ICE in gfc_conv_expr_descriptor) 2007-04-07 Paul Thomas PR fortran/31257 * intrinsic.c (add_functions): Add ref. to gfc_resolve_achar. * intrinsic.h : Add prototype for gfc_resolve_achar. * iresolve.c (gfc_resolve_achar): New function. 2007-04-07 Paul Thomas PR fortran/31257 * gfortran.dg/achar_4.f90: New test. From-SVN: r123646 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/intrinsic.c | 2 +- gcc/fortran/intrinsic.h | 1 + gcc/fortran/iresolve.c | 16 ++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/achar_4.f90 | 20 ++++++++++++++++++++ 6 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/achar_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 66915c73348..ce7b74437c3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-04-07 Paul Thomas + + PR fortran/31257 + * intrinsic.c (add_functions): Add ref. to gfc_resolve_achar. + * intrinsic.h : Add prototype for gfc_resolve_achar. + * iresolve.c (gfc_resolve_achar): New function. + 2007-04-07 Paul Thomas PR fortran/30880 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 76c2d3cc786..2210dc27cc9 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -951,7 +951,7 @@ add_functions (void) make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU); add_sym_1 ("achar", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95, - gfc_check_achar, gfc_simplify_achar, NULL, + gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar, i, BT_INTEGER, di, REQUIRED); make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 15af9120133..46d49f7e744 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -301,6 +301,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int); /* Resolution functions. */ void gfc_resolve_abs (gfc_expr *, gfc_expr *); void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_achar (gfc_expr *, gfc_expr *); void gfc_resolve_acos (gfc_expr *, gfc_expr *); void gfc_resolve_acosh (gfc_expr *, gfc_expr *); void gfc_resolve_aimag (gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 12ecd061e69..14ed3e32e8d 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -98,6 +98,22 @@ gfc_resolve_access (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED, } +void +gfc_resolve_achar (gfc_expr *f, gfc_expr *x) +{ + + f->ts.type = BT_CHARACTER; + f->ts.kind = gfc_default_character_kind; + f->ts.cl = gfc_get_charlen (); + f->ts.cl->next = gfc_current_ns->cl_list; + gfc_current_ns->cl_list = f->ts.cl; + f->ts.cl->length = gfc_int_expr (1); + + f->value.function.name + = gfc_get_string ("__achar_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); +} + + void gfc_resolve_acos (gfc_expr *f, gfc_expr *x) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bbcfcde7ad6..ace71ca6933 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-04-07 Paul Thomas + + PR fortran/31257 + * gfortran.dg/achar_4.f90: New test. + 2007-04-07 Paul Thomas PR fortran/30880 diff --git a/gcc/testsuite/gfortran.dg/achar_4.f90 b/gcc/testsuite/gfortran.dg/achar_4.f90 new file mode 100644 index 00000000000..3bbc2af5cb5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/achar_4.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! Tests the fix for PR31257, in which achar caused an ICE because it had no +! charlen. +! +! The code comes from http://www.star.le.ac.uk/~cgp/fortran.html (by Clive Page) +! Reported by Thomas Koenig +! + if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) call abort () +contains + Character (len=20) Function Up (string) + Character(len=*) string + Up = & + transfer(merge(achar(iachar(transfer(string,"x",len(string)))- & + (ichar('a')-ichar('A')) ), & + transfer(string,"x",len(string)) , & + transfer(string,"x",len(string)) >= "a" .and. & + transfer(string,"x",len(string)) <= "z"), repeat("x", len(string))) + return + end function Up +end -- 2.30.2