re PR fortran/31257 (ICE in gfc_conv_expr_descriptor)
2007-04-07 Paul Thomas <pault@gcc.gnu.org> 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 <pault@gcc.gnu.org> PR fortran/31257 * gfortran.dg/achar_4.f90: New test. From-SVN: r123646
This commit is contained in:
parent
145bdc2cbc
commit
3c19e5e1a1
@ -1,3 +1,10 @@
|
|||||||
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
|
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 <pault@gcc.gnu.org>
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/30880
|
PR fortran/30880
|
||||||
|
@ -951,7 +951,7 @@ add_functions (void)
|
|||||||
make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
|
make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
|
||||||
|
|
||||||
add_sym_1 ("achar", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
|
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);
|
i, BT_INTEGER, di, REQUIRED);
|
||||||
|
|
||||||
make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
|
make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
|
||||||
|
@ -301,6 +301,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int);
|
|||||||
/* Resolution functions. */
|
/* Resolution functions. */
|
||||||
void gfc_resolve_abs (gfc_expr *, gfc_expr *);
|
void gfc_resolve_abs (gfc_expr *, gfc_expr *);
|
||||||
void gfc_resolve_access (gfc_expr *, 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_acos (gfc_expr *, gfc_expr *);
|
||||||
void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
|
void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
|
||||||
void gfc_resolve_aimag (gfc_expr *, gfc_expr *);
|
void gfc_resolve_aimag (gfc_expr *, gfc_expr *);
|
||||||
|
@ -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
|
void
|
||||||
gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
|
gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
|
||||||
{
|
{
|
||||||
|
@ -1,3 +1,8 @@
|
|||||||
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/31257
|
||||||
|
* gfortran.dg/achar_4.f90: New test.
|
||||||
|
|
||||||
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
2007-04-07 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/30880
|
PR fortran/30880
|
||||||
|
20
gcc/testsuite/gfortran.dg/achar_4.f90
Normal file
20
gcc/testsuite/gfortran.dg/achar_4.f90
Normal file
@ -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 <tkoenig@gcc.gnu.org>
|
||||||
|
!
|
||||||
|
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
|
Loading…
Reference in New Issue
Block a user