diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2021-04-03 12:49:50 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2021-04-03 12:49:50 +0100 |
| commit | fc27115d6107f219e6f3dc610c99210005fe9dc5 (patch) | |
| tree | 1c8d46da9297cf7ede96efb196cf0bc9da38eac0 /gcc | |
| parent | a40015780f8cc49476741b6914bd5ee97bd10f1d (diff) | |
| download | gcc-fc27115d6107f219e6f3dc610c99210005fe9dc5.zip gcc-fc27115d6107f219e6f3dc610c99210005fe9dc5.tar.gz gcc-fc27115d6107f219e6f3dc610c99210005fe9dc5.tar.bz2 | |
Fortran: Fix ICE on wrong code [PR99818].
2021-04-03 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran/ChangeLog
PR fortran/99818
* interface.c (compare_parameter): The codimension attribute is
applied to the _data field of class formal arguments.
gcc/testsuite/ChangeLog
PR fortran/99818
* gfortran.dg/coarray_48.f90: New test.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/interface.c | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray_48.f90 | 24 |
2 files changed, 34 insertions, 4 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f7ca52e..6073612 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2327,6 +2327,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, bool rank_check, is_pointer; char err[200]; gfc_component *ppc; + bool codimension = false; /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding procs c_f_pointer or c_f_procpointer, and we need to accept most @@ -2490,7 +2491,12 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.codimension && !gfc_is_coarray (actual)) + if (formal->ts.type == BT_CLASS && formal->attr.class_ok) + codimension = CLASS_DATA (formal)->attr.codimension; + else + codimension = formal->attr.codimension; + + if (codimension && !gfc_is_coarray (actual)) { if (where) gfc_error ("Actual argument to %qs at %L must be a coarray", @@ -2498,7 +2504,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.codimension && formal->attr.allocatable) + if (codimension && formal->attr.allocatable) { gfc_ref *last = NULL; @@ -2520,7 +2526,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, } } - if (formal->attr.codimension) + if (codimension) { /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048). */ /* F2018, 12.5.2.8. */ @@ -2586,7 +2592,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.allocatable && !formal->attr.codimension + if (formal->attr.allocatable && !codimension && actual_attr.codimension) { if (formal->attr.intent == INTENT_OUT) diff --git a/gcc/testsuite/gfortran.dg/coarray_48.f90 b/gcc/testsuite/gfortran.dg/coarray_48.f90 new file mode 100644 index 0000000..adec014 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_48.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib" } +! +! Fix for P99818 in which wrong code caused an ICE. +! +! Contributed by Gerhard Steinmetz <gscfq@t-online.de> +! +module m + type t + integer :: a + contains + procedure :: s + end type +contains + subroutine s(x) + class(t) :: x[*] + end +end +program p + use m + associate (y => t(1)) + call y%s ! { dg-error "must be a coarray" } + end associate +end |