diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2025-12-04 22:16:10 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2025-12-05 19:49:14 +0100 |
| commit | ee9ded19244ab887759eb3faef452ee70316835e (patch) | |
| tree | 47af3ccb83d4b11cd55eeaa6c2fe7b3354420485 | |
| parent | d1ac432c5a889a101e5a81ec349f76e55403c2f4 (diff) | |
| download | gcc-ee9ded19244ab887759eb3faef452ee70316835e.zip gcc-ee9ded19244ab887759eb3faef452ee70316835e.tar.gz gcc-ee9ded19244ab887759eb3faef452ee70316835e.tar.bz2 | |
Fortran: associate to a contiguous pointer or target [PR122977]
PR fortran/122977
gcc/fortran/ChangeLog:
* expr.cc (gfc_is_simply_contiguous): For an associate variable
check whether the associate target is contiguous.
* resolve.cc (resolve_symbol): Skip array type check for an
associate variable when the target has the contiguous attribute.
gcc/testsuite/ChangeLog:
* gfortran.dg/contiguous_16.f90: New test.
| -rw-r--r-- | gcc/fortran/expr.cc | 8 | ||||
| -rw-r--r-- | gcc/fortran/resolve.cc | 1 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/contiguous_16.f90 | 51 |
3 files changed, 60 insertions, 0 deletions
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 00abd9e..054276e 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -6406,6 +6406,14 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))) return false; + /* An associate variable may point to a non-contiguous target. */ + if (ar && ar->type == AR_FULL + && sym->attr.associate_var && !sym->attr.contiguous + && sym->assoc + && sym->assoc->target) + return gfc_is_simply_contiguous (sym->assoc->target, strict, + permit_element); + if (!ar || ar->type == AR_FULL) return true; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 9f3ce1d..8e076c6 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -18143,6 +18143,7 @@ skip_interfaces: /* F2008, C530. */ if (sym->attr.contiguous + && !sym->attr.associate_var && (!class_attr.dimension || (as->type != AS_ASSUMED_SHAPE && as->type != AS_ASSUMED_RANK && !class_attr.pointer))) diff --git a/gcc/testsuite/gfortran.dg/contiguous_16.f90 b/gcc/testsuite/gfortran.dg/contiguous_16.f90 new file mode 100644 index 0000000..ae1ba26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/contiguous_16.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! { dg-options "-O2 -fdump-tree-original" } +! +! PR fortran/122977 - associate to a contiguous pointer + +program foo + integer, dimension(:), pointer, contiguous :: a + integer, dimension(:), allocatable :: u + allocate (a(4), u(4)) + if (.not. is_contiguous(a)) error stop 1 ! optimized + if (.not. is_contiguous(u)) error stop 2 ! optimized + + associate (b => a) + if (.not. is_contiguous(b)) error stop 3 ! optimized + associate (c => b) + if (.not. is_contiguous(c)) error stop 4 ! optimized + end associate + associate (c => b(1::2)) + if (is_contiguous(c)) stop 11 ! runtime check + end associate + end associate + + associate (v => u) + if (.not. is_contiguous(v)) error stop 5 ! optimized + associate (w => v) + if (.not. is_contiguous(w)) error stop 6 ! optimized + end associate + associate (w => v(1::2)) + if (is_contiguous(w)) stop 12 ! runtime check + end associate + end associate + + associate (b => a(1::2)) + if (is_contiguous(b)) stop 13 ! runtime check + associate (c => b) + if (is_contiguous(c)) stop 14 ! runtime check + end associate + end associate + + associate (v => u(1::2)) + if (is_contiguous(v)) stop 15 ! runtime check + associate (w => v) + if (is_contiguous(w)) stop 16 ! runtime check + end associate + end associate + + deallocate (a, u) +end program foo + +! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 6 "original" } } |