diff options
| author | Sandra Loosemore <sandra@codesourcery.com> | 2021-09-19 17:23:58 -0700 |
|---|---|---|
| committer | Sandra Loosemore <sandra@codesourcery.com> | 2021-09-22 17:09:29 -0700 |
| commit | 8fa9e73e6db0ff05447f5547df925fdcb4733d05 (patch) | |
| tree | b1d036675945e2d88c1498ea51db041f2d847f66 | |
| parent | 83aac698835edcdb3e6d96b856bef1c5f92e5e24 (diff) | |
| download | gcc-8fa9e73e6db0ff05447f5547df925fdcb4733d05.zip gcc-8fa9e73e6db0ff05447f5547df925fdcb4733d05.tar.gz gcc-8fa9e73e6db0ff05447f5547df925fdcb4733d05.tar.bz2 | |
Fortran: Fix testcases that violate C838, + revealed ICE
The three test cases fixed in this patch violated F2018 C838, which
only allows passing an assumed-rank argument to an assumed-rank dummy.
Wrapping the call in "select rank" revealed a null pointer dereference
which is fixed by guarding the use of the result of
GFC_DECL_SAVED_DESCRIPTOR similar to what is already done elsewhere.
2021-09-19 Sandra Loosemore <sandra@codesourcery.com>
gcc/fortran/
* trans-stmt.c (trans_associate_var): Check that result of
GFC_DECL_SAVED_DESCRIPTOR is not null before using it.
gcc/testsuite/
* gfortran.dg/assumed_rank_18.f90 (g): Wrap call to h in
select rank.
* gfortran.dg/assumed_type_10.f90 (test_array): Likewise for
call to test_lib.
* gfortran.dg/assumed_type_11.f90 (test_array): Likewise.
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/assumed_rank_18.f90 | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/assumed_type_10.f90 | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/assumed_type_11.f90 | 5 |
4 files changed, 16 insertions, 6 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 11df186..a8ff473 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1788,9 +1788,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* Go straight to the class data. */ if (sym2->attr.dummy && !sym2->attr.optional) { - class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ? - GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) : - sym2->backend_decl; + class_decl = sym2->backend_decl; + if (DECL_LANG_SPECIFIC (class_decl) + && GFC_DECL_SAVED_DESCRIPTOR (class_decl)) + class_decl = GFC_DECL_SAVED_DESCRIPTOR (class_decl); if (POINTER_TYPE_P (TREE_TYPE (class_decl))) class_decl = build_fold_indirect_ref_loc (input_location, class_decl); diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_18.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_18.f90 index a8fa3ff..0bc419a 100644 --- a/gcc/testsuite/gfortran.dg/assumed_rank_18.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_18.f90 @@ -7,7 +7,10 @@ program p contains subroutine g(x) real :: x(..) - call h(x) + select rank (x) + rank (1) + call h(x) + end select end subroutine h(x) real :: x(*) diff --git a/gcc/testsuite/gfortran.dg/assumed_type_10.f90 b/gcc/testsuite/gfortran.dg/assumed_type_10.f90 index bf0c873..a8bbf2d 100644 --- a/gcc/testsuite/gfortran.dg/assumed_type_10.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_type_10.f90 @@ -31,7 +31,10 @@ contains subroutine test_array (a) use iso_c_binding, only: c_size_t class(*), dimension(..), target :: a - call test_lib (a, int (sizeof (a), kind=c_size_t)) + select rank (a) + rank (1) + call test_lib (a, int (sizeof (a), kind=c_size_t)) + end select end subroutine end module diff --git a/gcc/testsuite/gfortran.dg/assumed_type_11.f90 b/gcc/testsuite/gfortran.dg/assumed_type_11.f90 index df6572d..391fa0d 100644 --- a/gcc/testsuite/gfortran.dg/assumed_type_11.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_type_11.f90 @@ -31,7 +31,10 @@ contains subroutine test_array (a) use iso_c_binding, only: c_size_t class(*), dimension(..), target :: a - call test_lib (a, int (sizeof (a), kind=c_size_t)) + select rank (a) + rank (1) + call test_lib (a, int (sizeof (a), kind=c_size_t)) + end select end subroutine end module |