Commit b3aefde2 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/43331 (Cray pointers generate bogus IL for the middle-end)

2010-03-17  Tobias Burnus  <burnus@net-b.de>

        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  <burnus@net-b.de>

        PR fortran/43331
        * gfortran.dg/cray_pointers_1.f90: Update dg-error message.

From-SVN: r157512
parent e33c42db
2010-03-17 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de> 2010-03-14 Tobias Burnus <burnus@net-b.de>
PR fortran/43362 PR fortran/43362
......
...@@ -6969,22 +6969,14 @@ gfc_match_derived_decl (void) ...@@ -6969,22 +6969,14 @@ gfc_match_derived_decl (void)
/* Cray Pointees can be declared as: /* Cray Pointees can be declared as:
pointer (ipt, a (n,m,...,*)) 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. */
match match
gfc_mod_pointee_as (gfc_array_spec *as) gfc_mod_pointee_as (gfc_array_spec *as)
{ {
as->cray_pointee = true; /* This will be useful to know later. */ as->cray_pointee = true; /* This will be useful to know later. */
if (as->type == AS_ASSUMED_SIZE) if (as->type == AS_ASSUMED_SIZE)
{ as->cp_was_assumed = true;
as->type = AS_EXPLICIT;
as->upper[as->rank - 1] = gfc_int_expr (1);
as->cp_was_assumed = true;
}
else if (as->type == AS_ASSUMED_SHAPE) else if (as->type == AS_ASSUMED_SHAPE)
{ {
gfc_error ("Cray Pointee at %C cannot be assumed shape array"); gfc_error ("Cray Pointee at %C cannot be assumed shape array");
......
...@@ -3010,16 +3010,6 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) ...@@ -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(). */ /* This is possibly a typo: x = f() instead of x => f(). */
if (gfc_option.warn_surprising if (gfc_option.warn_surprising
&& rvalue->expr_type == EXPR_FUNCTION && rvalue->expr_type == EXPR_FUNCTION
......
...@@ -11010,7 +11010,7 @@ resolve_symbol (gfc_symbol *sym) ...@@ -11010,7 +11010,7 @@ resolve_symbol (gfc_symbol *sym)
arguments. */ arguments. */
if (sym->as != NULL 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->as->type == AS_ASSUMED_SHAPE)
&& sym->attr.dummy == 0) && sym->attr.dummy == 0)
{ {
......
...@@ -2404,8 +2404,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, ...@@ -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 = gfc_trans_array_bound_check (se, info->descriptor,
index, dim, &ar->where, index, dim, &ar->where,
(ar->as->type != AS_ASSUMED_SIZE ar->as->type != AS_ASSUMED_SIZE
&& !ar->as->cp_was_assumed) || dim < ar->dimen - 1); || dim < ar->dimen - 1);
break; break;
case DIMEN_VECTOR: case DIMEN_VECTOR:
...@@ -2431,8 +2431,8 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, ...@@ -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. */ /* Do any bounds checking on the final info->descriptor index. */
index = gfc_trans_array_bound_check (se, info->descriptor, index = gfc_trans_array_bound_check (se, info->descriptor,
index, dim, &ar->where, index, dim, &ar->where,
(ar->as->type != AS_ASSUMED_SIZE ar->as->type != AS_ASSUMED_SIZE
&& !ar->as->cp_was_assumed) || dim < ar->dimen - 1); || dim < ar->dimen - 1);
break; break;
case DIMEN_RANGE: case DIMEN_RANGE:
...@@ -2581,8 +2581,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, ...@@ -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 /* Upper bound, but not for the last dimension of assumed-size
arrays. */ arrays. */
if (n < ar->dimen - 1 if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
|| (ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed))
{ {
tmp = gfc_conv_array_ubound (se->expr, n); tmp = gfc_conv_array_ubound (se->expr, n);
if (sym->attr.temporary) if (sym->attr.temporary)
...@@ -3207,8 +3206,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) ...@@ -3207,8 +3206,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
continue; continue;
if (dim == info->ref->u.ar.dimen - 1 if (dim == info->ref->u.ar.dimen - 1
&& (info->ref->u.ar.as->type == AS_ASSUMED_SIZE && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
|| info->ref->u.ar.as->cp_was_assumed))
check_upper = false; check_upper = false;
else else
check_upper = true; check_upper = true;
......
...@@ -598,6 +598,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) ...@@ -598,6 +598,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
if (!sym->attr.target if (!sym->attr.target
&& !sym->attr.pointer && !sym->attr.pointer
&& !sym->attr.cray_pointee
&& !sym->attr.proc_pointer) && !sym->attr.proc_pointer)
DECL_RESTRICTED_P (decl) = 1; DECL_RESTRICTED_P (decl) = 1;
} }
...@@ -3159,10 +3160,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) ...@@ -3159,10 +3160,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
case AS_ASSUMED_SIZE: case AS_ASSUMED_SIZE:
/* Must be a dummy parameter. */ /* 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. */ /* 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; break;
case AS_ASSUMED_SHAPE: case AS_ASSUMED_SHAPE:
......
...@@ -1193,7 +1193,7 @@ gfc_is_nodesc_array (gfc_symbol * sym) ...@@ -1193,7 +1193,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
if (sym->attr.result || sym->attr.function) if (sym->attr.result || sym->attr.function)
return 0; return 0;
gcc_assert (sym->as->type == AS_EXPLICIT); gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed);
return 1; return 1;
} }
...@@ -1775,7 +1775,7 @@ gfc_sym_type (gfc_symbol * sym) ...@@ -1775,7 +1775,7 @@ gfc_sym_type (gfc_symbol * sym)
byref = 0; byref = 0;
restricted = !sym->attr.target && !sym->attr.pointer restricted = !sym->attr.target && !sym->attr.pointer
&& !sym->attr.proc_pointer; && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
if (sym->attr.dimension) if (sym->attr.dimension)
{ {
if (gfc_is_nodesc_array (sym)) if (gfc_is_nodesc_array (sym))
......
2010-03-17 Tobias Burnus <burnus@net-b.de>
PR fortran/43331
* gfortran.dg/cray_pointers_1.f90: Update dg-error message.
2010-03-16 Uros Bizjak <ubizjak@gmail.com> 2010-03-16 Uros Bizjak <ubizjak@gmail.com>
* gcc.dg/graphite/block-3.c: Add dg-timeout-factor. * gcc.dg/graphite/block-3.c: Add dg-timeout-factor.
......
...@@ -21,7 +21,7 @@ subroutine err3 ...@@ -21,7 +21,7 @@ subroutine err3
real array(*) real array(*)
pointer (ipt, array) pointer (ipt, array)
ipt = loc (target) ipt = loc (target)
array = 0 ! { dg-error "Vector assignment" } array = 0 ! { dg-error "upper bound in the last dimension" }
end subroutine err3 end subroutine err3
subroutine err4 subroutine err4
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment