From b3aefde2131ab8147d9cad974b24798b1b0a5d91 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 17 Mar 2010 10:53:40 +0100 Subject: [PATCH] re PR fortran/43331 (Cray pointers generate bogus IL for the middle-end) 2010-03-17 Tobias Burnus PR fortran/43331 * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref, gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed check. * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray pointees as having explizit size. * expr.c (gfc_check_assign): Remove now unreachable Cray pointee check. * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to * assert. (gfc_sym_type): Don't mark Cray pointees as restricted pointers. * resolve.c (resolve_symbol): Handle cp_was_assumed. * trans-decl.c (gfc_trans_deferred_vars): Ditto. (gfc_finish_var_decl): Don't mark Cray pointees as restricted pointers. 2010-03-17 Tobias Burnus PR fortran/43331 * gfortran.dg/cray_pointers_1.f90: Update dg-error message. From-SVN: r157512 --- gcc/fortran/ChangeLog | 17 +++++++++++++++++ gcc/fortran/decl.c | 12 ++---------- gcc/fortran/expr.c | 10 ---------- gcc/fortran/resolve.c | 2 +- gcc/fortran/trans-array.c | 14 ++++++-------- gcc/fortran/trans-decl.c | 6 ++++-- gcc/fortran/trans-types.c | 4 ++-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/cray_pointers_1.f90 | 2 +- 9 files changed, 38 insertions(+), 34 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dd809d9c23d..e445a6a7577 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2010-03-17 Tobias Burnus + + PR fortran/43331 + * trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref, + gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed + check. + * decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray + pointees as having explizit size. + * expr.c (gfc_check_assign): Remove now unreachable Cray pointee + check. + * trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to assert. + (gfc_sym_type): Don't mark Cray pointees as restricted pointers. + * resolve.c (resolve_symbol): Handle cp_was_assumed. + * trans-decl.c (gfc_trans_deferred_vars): Ditto. + (gfc_finish_var_decl): Don't mark Cray pointees as restricted + pointers. + 2010-03-14 Tobias Burnus PR fortran/43362 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 04669061bf8..692078a11d4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6969,22 +6969,14 @@ gfc_match_derived_decl (void) /* Cray Pointees can be declared as: - pointer (ipt, a (n,m,...,*)) - By default, this is treated as an AS_ASSUMED_SIZE array. We'll - cheat and set a constant bound of 1 for the last dimension, if this - is the case. Since there is no bounds-checking for Cray Pointees, - this will be okay. */ + pointer (ipt, a (n,m,...,*)) */ match gfc_mod_pointee_as (gfc_array_spec *as) { as->cray_pointee = true; /* This will be useful to know later. */ if (as->type == AS_ASSUMED_SIZE) - { - as->type = AS_EXPLICIT; - as->upper[as->rank - 1] = gfc_int_expr (1); - as->cp_was_assumed = true; - } + as->cp_was_assumed = true; else if (as->type == AS_ASSUMED_SHAPE) { gfc_error ("Cray Pointee at %C cannot be assumed shape array"); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 6d3ca8476b8..58c906375ea 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3010,16 +3010,6 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) } } - if (sym->attr.cray_pointee - && lvalue->ref != NULL - && lvalue->ref->u.ar.type == AR_FULL - && lvalue->ref->u.ar.as->cp_was_assumed) - { - gfc_error ("Vector assignment to assumed-size Cray Pointee at %L " - "is illegal", &lvalue->where); - return FAILURE; - } - /* This is possibly a typo: x = f() instead of x => f(). */ if (gfc_option.warn_surprising && rvalue->expr_type == EXPR_FUNCTION diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 774dfe4f2ea..de316da840d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11010,7 +11010,7 @@ resolve_symbol (gfc_symbol *sym) arguments. */ if (sym->as != NULL - && (sym->as->type == AS_ASSUMED_SIZE + && ((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed) || sym->as->type == AS_ASSUMED_SHAPE) && sym->attr.dummy == 0) { diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8eea3aca716..5eeead831c4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2404,8 +2404,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, index = gfc_trans_array_bound_check (se, info->descriptor, index, dim, &ar->where, - (ar->as->type != AS_ASSUMED_SIZE - && !ar->as->cp_was_assumed) || dim < ar->dimen - 1); + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_VECTOR: @@ -2431,8 +2431,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, /* Do any bounds checking on the final info->descriptor index. */ index = gfc_trans_array_bound_check (se, info->descriptor, index, dim, &ar->where, - (ar->as->type != AS_ASSUMED_SIZE - && !ar->as->cp_was_assumed) || dim < ar->dimen - 1); + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_RANGE: @@ -2581,8 +2581,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, /* Upper bound, but not for the last dimension of assumed-size arrays. */ - if (n < ar->dimen - 1 - || (ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)) + if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE) { tmp = gfc_conv_array_ubound (se->expr, n); if (sym->attr.temporary) @@ -3207,8 +3206,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) continue; if (dim == info->ref->u.ar.dimen - 1 - && (info->ref->u.ar.as->type == AS_ASSUMED_SIZE - || info->ref->u.ar.as->cp_was_assumed)) + && info->ref->u.ar.as->type == AS_ASSUMED_SIZE) check_upper = false; else check_upper = true; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 34e153ae77b..6f5f7796da8 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -598,6 +598,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (!sym->attr.target && !sym->attr.pointer + && !sym->attr.cray_pointee && !sym->attr.proc_pointer) DECL_RESTRICTED_P (decl) = 1; } @@ -3159,10 +3160,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) case AS_ASSUMED_SIZE: /* Must be a dummy parameter. */ - gcc_assert (sym->attr.dummy); + gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed); /* We should always pass assumed size arrays the g77 way. */ - fnbody = gfc_trans_g77_array (sym, fnbody); + if (sym->attr.dummy) + fnbody = gfc_trans_g77_array (sym, fnbody); break; case AS_ASSUMED_SHAPE: diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 278ae27a458..ebe4c2f832b 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1193,7 +1193,7 @@ gfc_is_nodesc_array (gfc_symbol * sym) if (sym->attr.result || sym->attr.function) return 0; - gcc_assert (sym->as->type == AS_EXPLICIT); + gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed); return 1; } @@ -1775,7 +1775,7 @@ gfc_sym_type (gfc_symbol * sym) byref = 0; restricted = !sym->attr.target && !sym->attr.pointer - && !sym->attr.proc_pointer; + && !sym->attr.proc_pointer && !sym->attr.cray_pointee; if (sym->attr.dimension) { if (gfc_is_nodesc_array (sym)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bd8929993b7..bd2b05e5bc6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-03-17 Tobias Burnus + + PR fortran/43331 + * gfortran.dg/cray_pointers_1.f90: Update dg-error message. + 2010-03-16 Uros Bizjak * gcc.dg/graphite/block-3.c: Add dg-timeout-factor. diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 index b23a300feac..87ace6848bd 100644 --- a/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 +++ b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 @@ -21,7 +21,7 @@ subroutine err3 real array(*) pointer (ipt, array) ipt = loc (target) - array = 0 ! { dg-error "Vector assignment" } + array = 0 ! { dg-error "upper bound in the last dimension" } end subroutine err3 subroutine err4