diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2021-05-27 13:58:26 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2021-05-27 13:58:26 +0200 |
| commit | 71d7dc6cd09b603bcc58d5d1747a86eb498bb147 (patch) | |
| tree | 13bd2be3d3a67a82d3833dcdee0ced06ca7a50d6 | |
| parent | 9d3a953ec4d2695e9a6bfa5f22655e2aea47a973 (diff) | |
| download | gcc-71d7dc6cd09b603bcc58d5d1747a86eb498bb147.zip gcc-71d7dc6cd09b603bcc58d5d1747a86eb498bb147.tar.gz gcc-71d7dc6cd09b603bcc58d5d1747a86eb498bb147.tar.bz2 | |
Fortran: Fix erroneous "pointer argument is not associated" runtime error
For CLASS arrays we need to use the CLASS data attributes to determine
which runtime check to generate.
gcc/fortran/ChangeLog:
PR fortran/100602
* trans-intrinsic.c (gfc_conv_intrinsic_size): Use CLASS data
attributes for CLASS arrays for generation of runtime error.
gcc/testsuite/ChangeLog:
PR fortran/100602
* gfortran.dg/pointer_check_14.f90: New test.
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pointer_check_14.f90 | 28 |
2 files changed, 36 insertions, 1 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index db9248c..98fa28d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8004,7 +8004,14 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) tree temp; tree cond; - attr = sym ? sym->attr : gfc_expr_attr (e); + if (e->symtree->n.sym && IS_CLASS_ARRAY (e->symtree->n.sym)) + { + attr = CLASS_DATA (e->symtree->n.sym)->attr; + attr.pointer = attr.class_pointer; + } + else + attr = gfc_expr_attr (e); + if (attr.allocatable) msg = xasprintf ("Allocatable argument '%s' is not allocated", e->symtree->n.sym->name); diff --git a/gcc/testsuite/gfortran.dg/pointer_check_14.f90 b/gcc/testsuite/gfortran.dg/pointer_check_14.f90 new file mode 100644 index 0000000..8ef6b36 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_check_14.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-fcheck=pointer -fdump-tree-original" } +! PR100602 - Erroneous "pointer argument is not associated" runtime error + +module m + type :: T + end type +contains + subroutine f(this) + class(T), intent(in) :: this(:) + class(T), allocatable :: ca(:) + class(T), pointer :: cp(:) + if (size (this) == 0) return + write(*,*) size (this) + stop 1 + write(*,*) size (ca) ! Check #1 + write(*,*) size (cp) ! Check #2 + end subroutine f +end module + +program main + use m + call f([T::]) +end program + +! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 2 "original" } } +! { dg-final { scan-tree-dump-times "Allocatable argument .*ca" 1 "original" } } +! { dg-final { scan-tree-dump-times "Pointer argument .*cp" 1 "original" } } |