Hello world,
the attached patch warns about the dubious pointer assignments (see
test case for details). I think an unconditional warning is OK
in this case because
- Assigning to a pointer from an obvious non-contiguous target
is not useful at all, that I can see
- Some language laywer will come up with the fact that it is,
in fact, legal if the target is empty or has a single
element only, so a hard error would be a rejects-valid.
However, I can also make this into a warning depending on
-Wall, if this is preferred.
Regresson-tested. OK for trunk?
Regards
Thomas
2017-08-27 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/49232
* expr.c (gfc_check_pointer_assign): Warn for
suspicious assignments with contiguous pointers.
2017-08-27 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/49232
* gfortran.dg/contiguous_4.f90: New test.
Index: expr.c
===================================================================
--- expr.c (Revision 239977)
+++ expr.c (Arbeitskopie)
@@ -3764,6 +3764,66 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
}
}
+ /* Warn for suspicious assignments like
+
+ pointer, real, dimension(:), contiguous :: p
+ real, dimension(10,10) :: a
+ p => a(:,:,2) or p => a(2:4,:) */
+
+ if (lhs_attr.contiguous)
+ {
+ gfc_array_ref *ar;
+ int i;
+ bool do_warn;
+
+ do_warn = false;
+ ar = NULL;
+
+ for (ref = rvalue->ref; ref; ref = ref->next)
+ {
+ if (ref->type == REF_ARRAY)
+ {
+ ar = &ref->u.ar;
+ break;
+ }
+ }
+ if (ar && ar->type == AR_SECTION)
+ {
+
+ for (i = 0; i < ar->dimen; i++)
+ {
+ if (ar->dimen_type[i] == DIMEN_RANGE && ar->stride[i]
+ && (ar->stride[i]->expr_type != EXPR_CONSTANT
+ || (ar->stride[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp_si (ar->stride[i]->value.integer, 1))))
+ {
+ do_warn = true;
+ break;
+ }
+ }
+ if (!do_warn && ar->dimen > 1)
+ {
+ for (i = 0; i < ar->dimen - 1; i++)
+ {
+ if ((ar->start[i] && ar->as->lower[i]
+ && gfc_dep_compare_expr (ar->start[i], ar->as->lower[i])
+ != 0)
+ || (ar->end[i] && ar->as->upper[i]
+ && gfc_dep_compare_expr (ar->end[i], ar->as->upper[i])
+ != 0))
+ {
+ do_warn = true;
+ break;
+ }
+ }
+ }
+ }
+ if (do_warn)
+ gfc_warning (0, "Assignment to contiguous pointer from "
+ "possibly non-contiguous target at %L",
+ &rvalue->where);
+ }
+
/* Warn if it is the LHS pointer may lives longer than the RHS target. */
if (warn_target_lifetime
&& rvalue->expr_type == EXPR_VARIABLE
! { dg-do compile }
program cont_01_neg
implicit none
real, pointer, contiguous :: r(:)
real, pointer, contiguous :: r2(:,:)
real, target :: x(45)
real, target :: x2(5,9)
integer :: i
x = (/ (real(i),i=1,45) /)
x2 = reshape(x,shape(x2))
r => x(::3) ! { dg-warning "Assignment to contiguous pointer" }
r2 => x2(2:,:) ! { dg-warning "Assignment to contiguous pointer" }
r2 => x2(:,2:3)
end program
