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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123646
138bc75d-0d04-0410-961f-
82ee72b054a4
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/30880
* resolve.c (resolve_fl_variable): Set flag to 2 for automatic
arrays. Make condition for automatic array error explicit.
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);
/* 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 *);
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)
{
f->ts = x->ts;
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>
+
PR fortran/30880
* gfortran.dg/used_dummy_types_8.f90: New test.
--- /dev/null
+! { 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