re PR fortran/82257 (f951: Internal compiler error segmentation fault)
2018-01-15 Louis Krupp <louis.krupp@zoho.com> PR fortran/82257 * interface.c (compare_rank): Don't try to retrieve CLASS_DATA from symbol marked unlimited polymorphic. * resolve.c (resolve_structure_cons): Likewise. * misc.c (gfc_typename): Don't dereference derived->components if it's NULL. 2018-01-15 Louis Krupp <louis.krupp@zoho.com> PR fortran/82257 * gfortran.dg/unlimited_polymorphic_28.f90: New test. From-SVN: r256720
This commit is contained in:
parent
c662b64cf9
commit
75a3c61ae4
|
@ -1,3 +1,12 @@
|
|||
2018-01-15 Louis Krupp <louis.krupp@zoho.com>
|
||||
|
||||
PR fortran/82257
|
||||
* interface.c (compare_rank): Don't try to retrieve CLASS_DATA
|
||||
from symbol marked unlimited polymorphic.
|
||||
* resolve.c (resolve_structure_cons): Likewise.
|
||||
* misc.c (gfc_typename): Don't dereference derived->components
|
||||
if it's NULL.
|
||||
|
||||
2018-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/54613
|
||||
|
|
|
@ -754,8 +754,12 @@ compare_rank (gfc_symbol *s1, gfc_symbol *s2)
|
|||
if (s2->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
|
||||
return true;
|
||||
|
||||
as1 = (s1->ts.type == BT_CLASS) ? CLASS_DATA (s1)->as : s1->as;
|
||||
as2 = (s2->ts.type == BT_CLASS) ? CLASS_DATA (s2)->as : s2->as;
|
||||
as1 = (s1->ts.type == BT_CLASS
|
||||
&& !s1->ts.u.derived->attr.unlimited_polymorphic)
|
||||
? CLASS_DATA (s1)->as : s1->as;
|
||||
as2 = (s2->ts.type == BT_CLASS
|
||||
&& !s2->ts.u.derived->attr.unlimited_polymorphic)
|
||||
? CLASS_DATA (s2)->as : s2->as;
|
||||
|
||||
r1 = as1 ? as1->rank : 0;
|
||||
r2 = as2 ? as2->rank : 0;
|
||||
|
|
|
@ -156,7 +156,8 @@ gfc_typename (gfc_typespec *ts)
|
|||
sprintf (buffer, "TYPE(%s)", ts->u.derived->name);
|
||||
break;
|
||||
case BT_CLASS:
|
||||
ts = &ts->u.derived->components->ts;
|
||||
if (ts->u.derived->components)
|
||||
ts = &ts->u.derived->components->ts;
|
||||
if (ts->u.derived->attr.unlimited_polymorphic)
|
||||
sprintf (buffer, "CLASS(*)");
|
||||
else
|
||||
|
|
|
@ -1289,7 +1289,9 @@ resolve_structure_cons (gfc_expr *expr, int init)
|
|||
}
|
||||
|
||||
rank = comp->as ? comp->as->rank : 0;
|
||||
if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->as)
|
||||
if (comp->ts.type == BT_CLASS
|
||||
&& !comp->ts.u.derived->attr.unlimited_polymorphic
|
||||
&& CLASS_DATA (comp)->as)
|
||||
rank = CLASS_DATA (comp)->as->rank;
|
||||
|
||||
if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2018-01-15 Louis Krupp <louis.krupp@zoho.com>
|
||||
|
||||
PR fortran/82257
|
||||
* gfortran.dg/unlimited_polymorphic_28.f90: New test.
|
||||
|
||||
2018-01-15 Martin Sebor <msebor@redhat.com>
|
||||
|
||||
PR testsuite/83869
|
||||
|
|
|
@ -0,0 +1,51 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! PR 82257: ICE in gfc_typename(), compare_rank(), resolve_structure_cons()
|
||||
|
||||
module m1
|
||||
|
||||
implicit none
|
||||
|
||||
type,abstract :: c_base
|
||||
contains
|
||||
procedure(i1),private,deferred :: f_base
|
||||
end type c_base
|
||||
|
||||
abstract interface
|
||||
function i1(this) result(res)
|
||||
import
|
||||
class(c_base),intent(IN) :: this
|
||||
class(c_base), pointer :: res
|
||||
end function i1
|
||||
end interface
|
||||
|
||||
type,abstract,extends(c_base) :: c_derived
|
||||
contains
|
||||
procedure :: f_base => f_derived ! { dg-error "Type mismatch in function result \\(CLASS\\(\\*\\)/CLASS\\(c_base\\)\\)" }
|
||||
end type c_derived
|
||||
|
||||
contains
|
||||
|
||||
function f_derived(this) result(res) ! { dg-error "must be dummy, allocatable or pointer" }
|
||||
class(c_derived), intent(IN) :: this
|
||||
class(*) :: res
|
||||
end function f_derived
|
||||
|
||||
end module m1
|
||||
|
||||
module m2
|
||||
|
||||
implicit none
|
||||
|
||||
type :: t
|
||||
contains
|
||||
procedure :: p
|
||||
end type t
|
||||
|
||||
contains
|
||||
|
||||
class(*) function p(this) ! { dg-error "must be dummy, allocatable or pointer" }
|
||||
class(t), intent(IN) :: this
|
||||
end function p
|
||||
|
||||
end module m2
|
Loading…
Reference in New Issue