diff options
Diffstat (limited to 'gcc')
| -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" } } |