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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 66915c733487970f5997dafa570f40a9d46b2ca5..ce7b74437c377cf8197f4ec14779b55d75760a37 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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>
 
        PR fortran/30880

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 76c2d3cc78669a83795fd4b0e1982c047af4a1ea..2210dc27cc9cbb3edf53f07e7e2b91e93977b4cd 100644 (file)
--- 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 15af912013337e037f066051a4c99873caedf335..46d49f7e7442e91e24216d32f7c561dc8fb82cb9 100644 (file)
--- 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 12ecd061e69dec1c15ad7238759a5983112d45bd..14ed3e32e8dccfa91fbb6acfdd071f0ccc6f413e 100644 (file)
--- 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 bbcfcde7ad6ada69c12eff14b94c629a8b330437..ace71ca69335ebdc5373ed3f1849e18d7fad3ce6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 
        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 (file)
index 0000000..3bbc2af
--- /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 <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