aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/trans-array.c40
-rw-r--r--gcc/fortran/trans-expr.c47
-rw-r--r--gcc/fortran/trans.h2
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gfortran.dg/pr17612.f9037
6 files changed, 129 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7cc833b..f99c54f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2004-10-04 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+ Paul Brook <paul@codesourcery.com>
+
+ * trans-array.c (gfc_conv_expr_descriptor): Check for substriungs.
+ Use gfc_get_expr_charlen.
+ * trans-expr.c (gfc_get_expr_charlen): New function.
+ * trans.h (gfc_get_expr_charlen): Add prototype.
+
2004-10-04 Kazu Hirata <kazu@cs.umass.edu>
* trans-intrinsic.c: Fix a comment typo.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 9fe3513..a6397d3 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3486,6 +3486,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
tree offset;
int full;
gfc_ss *vss;
+ gfc_ref *ref;
gcc_assert (ss != gfc_ss_terminator);
@@ -3528,23 +3529,42 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
full = 0;
else
{
- gcc_assert (info->ref->u.ar.type == AR_SECTION);
+ ref = info->ref;
+ gcc_assert (ref->u.ar.type == AR_SECTION);
full = 1;
- for (n = 0; n < info->ref->u.ar.dimen; n++)
+ for (n = 0; n < ref->u.ar.dimen; n++)
{
/* Detect passing the full array as a section. This could do
even more checking, but it doesn't seem worth it. */
- if (info->ref->u.ar.start[n]
- || info->ref->u.ar.end[n]
- || (info->ref->u.ar.stride[n]
- && !gfc_expr_is_one (info->ref->u.ar.stride[n], 0)))
+ if (ref->u.ar.start[n]
+ || ref->u.ar.end[n]
+ || (ref->u.ar.stride[n]
+ && !gfc_expr_is_one (ref->u.ar.stride[n], 0)))
{
full = 0;
break;
}
}
}
+
+ /* Check for substring references. */
+ ref = expr->ref;
+ if (!need_tmp && ref && expr->ts.type == BT_CHARACTER)
+ {
+ while (ref->next)
+ ref = ref->next;
+ if (ref->type == REF_SUBSTRING)
+ {
+ /* In general character substrings need a copy. Character
+ array strides are expressed as multiples of the element
+ size (consistent with other array types), not in
+ characters. */
+ full = 0;
+ need_tmp = 1;
+ }
+ }
+
if (full)
{
if (se->direct_byref)
@@ -3562,8 +3582,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
{
se->expr = desc;
}
+
if (expr->ts.type == BT_CHARACTER)
- se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
+ se->string_length = gfc_get_expr_charlen (expr);
+
return;
}
break;
@@ -3634,7 +3656,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
loop.temp_ss->type = GFC_SS_TEMP;
loop.temp_ss->next = gfc_ss_terminator;
loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
- /* Which can hold our string, if present. */
+ /* ... which can hold our string, if present. */
if (expr->ts.type == BT_CHARACTER)
se->string_length = loop.temp_ss->string_length
= TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
@@ -3716,7 +3738,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* Set the string_length for a character array. */
if (expr->ts.type == BT_CHARACTER)
- se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
+ se->string_length = gfc_get_expr_charlen (expr);
desc = info->descriptor;
gcc_assert (secss && secss != gfc_ss_terminator);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index fc5b41b..45f3acf 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -140,6 +140,53 @@ gfc_conv_expr_present (gfc_symbol * sym)
}
+/* Get the character length of an expression, looking through gfc_refs
+ if necessary. */
+
+tree
+gfc_get_expr_charlen (gfc_expr *e)
+{
+ gfc_ref *r;
+ tree length;
+
+ gcc_assert (e->expr_type == EXPR_VARIABLE
+ && e->ts.type == BT_CHARACTER);
+
+ length = NULL; /* To silence compiler warning. */
+
+ /* First candidate: if the variable is of type CHARACTER, the
+ expression's length could be the length of the character
+ variable. */
+ if (e->symtree->n.sym->ts.type == BT_CHARACTER)
+ length = e->symtree->n.sym->ts.cl->backend_decl;
+
+ /* Look through the reference chain for component references. */
+ for (r = e->ref; r; r = r->next)
+ {
+ switch (r->type)
+ {
+ case REF_COMPONENT:
+ if (r->u.c.component->ts.type == BT_CHARACTER)
+ length = r->u.c.component->ts.cl->backend_decl;
+ break;
+
+ case REF_ARRAY:
+ /* Do nothing. */
+ break;
+
+ default:
+ /* We should never got substring references here. These will be
+ broken down by the scalarizer. */
+ gcc_unreachable ();
+ }
+ }
+
+ gcc_assert (length != NULL);
+ return length;
+}
+
+
+
/* Generate code to initialize a string length variable. Returns the
value. */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 67bc234..f61fd4f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -316,6 +316,8 @@ tree gfc_conv_expr_present (gfc_symbol *);
/* Generate code to allocate a string temporary. */
tree gfc_conv_string_tmp (gfc_se *, tree, tree);
+/* Get the string length variable belonging to an expression. */
+tree gfc_get_expr_charlen (gfc_expr *);
/* Initialize a string length variable. */
void gfc_trans_init_string_length (gfc_charlen *, stmtblock_t *);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4d1a7ce..3f54500 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2004-10-04 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * gfortran.dg/pr17612.f90: New test.
+
2004-10-03 Gabriel Dos Reis <gdr@integrable-solutions.net>
* g++.dg/template/local1.C: Adjust quoting marks in
diff --git a/gcc/testsuite/gfortran.dg/pr17612.f90 b/gcc/testsuite/gfortran.dg/pr17612.f90
new file mode 100644
index 0000000..1b68532
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17612.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR 17612
+! We used to not determine the length of character-valued expressions
+! correctly, leading to a segfault.
+program prog
+ character(len=2), target :: c(4)
+ type pseudo_upf
+ character(len=2), pointer :: els(:)
+ end type pseudo_upf
+ type (pseudo_upf) :: p
+ type t
+ character(5) :: s(2)
+ end type
+ type (t) v
+ ! A full arrays.
+ c = (/"ab","cd","ef","gh"/)
+ call n(p)
+ if (any (c /= p%els)) call abort
+ ! An array section that needs a new array descriptor.
+ v%s(1) = "hello"
+ v%s(2) = "world"
+ call test (v%s)
+contains
+
+ subroutine n (upf)
+ type (pseudo_upf), intent(inout) :: upf
+ upf%els => c
+ return
+ end subroutine n
+
+ subroutine test(s)
+ character(len=*) :: s(:)
+ if ((len (s) .ne. 5) .or. (any (s .ne. (/"hello", "world"/)))) call abort
+ end subroutine
+end program
+
+
generated by cgit v1.1 at 2025-03-10 20:01:56 +0000