diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2011-05-14 09:48:08 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2011-05-14 09:48:08 +0000 |
| commit | 222c2a639505176798bb60e9a07b88ee90451c2a (patch) | |
| tree | 6e170974fca6afa5c0b90e0f2ef27c5b8f974282 /gcc/fortran | |
| parent | 2d8c9ad5c96e9a66b11deedb894822143202392e (diff) | |
| download | gcc-222c2a639505176798bb60e9a07b88ee90451c2a.zip gcc-222c2a639505176798bb60e9a07b88ee90451c2a.tar.gz gcc-222c2a639505176798bb60e9a07b88ee90451c2a.tar.bz2 | |
re PR fortran/22572 (Double occurrence of matmul intrinsic not optimised)
2011-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/22572
* frontend-passes.c (cfe_register_funcs): Also register functions
for potential elimination if the rank is > 0, the shape is unknown
and reallocate on assignment is active.
(create_var): For rank > 0 functions with unknown shape, create
an allocatable temporary.
2011-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/22572
* function_optimize_7.f90: New test case.
From-SVN: r173752
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 52 |
2 files changed, 43 insertions, 18 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b416831..8e2ec73 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-05-14 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/22572 + * frontend-passes.c (cfe_register_funcs): Also register functions + for potential elimination if the rank is > 0, the shape is unknown + and reallocate on assignment is active. + (create_var): For rank > 0 functions with unknown shape, create + an allocatable temporary. + 2011-05-14 Tobias Burnus <burnus@net-b.de> * options.c (gfc_init_options, gfc_post_options): Enable diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 85af45e..186cbb4 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -152,11 +152,11 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, if ((*e)->ts.type == BT_CHARACTER) return 0; - /* If we don't know the shape at compile time, we do not create a temporary - variable to hold the intermediate result. FIXME: Change this later when - allocation on assignment works for intrinsics. */ + /* If we don't know the shape at compile time, we create an allocatable + temporary variable to hold the intermediate result, but only if + allocation on assignment is active. */ - if ((*e)->rank > 0 && (*e)->shape == NULL) + if ((*e)->rank > 0 && (*e)->shape == NULL && !gfc_option.flag_realloc_lhs) return 0; /* Skip the test for pure functions if -faggressive-function-elimination @@ -250,22 +250,38 @@ create_var (gfc_expr * e) symbol = symtree->n.sym; symbol->ts = e->ts; - symbol->as = gfc_get_array_spec (); - symbol->as->rank = e->rank; - symbol->as->type = AS_EXPLICIT; - for (i=0; i<e->rank; i++) + + if (e->rank > 0) { - gfc_expr *p, *q; + symbol->as = gfc_get_array_spec (); + symbol->as->rank = e->rank; + + if (e->shape == NULL) + { + /* We don't know the shape at compile time, so we use an + allocatable. */ + symbol->as->type = AS_DEFERRED; + symbol->attr.allocatable = 1; + } + else + { + symbol->as->type = AS_EXPLICIT; + /* Copy the shape. */ + for (i=0; i<e->rank; i++) + { + gfc_expr *p, *q; - p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, - &(e->where)); - mpz_set_si (p->value.integer, 1); - symbol->as->lower[i] = p; - - q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, - &(e->where)); - mpz_set (q->value.integer, e->shape[i]); - symbol->as->upper[i] = q; + p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, + &(e->where)); + mpz_set_si (p->value.integer, 1); + symbol->as->lower[i] = p; + + q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind, + &(e->where)); + mpz_set (q->value.integer, e->shape[i]); + symbol->as->upper[i] = q; + } + } } symbol->attr.flavor = FL_VARIABLE; |