diff options
| -rw-r--r-- | gcc/fortran/intrinsic.c | 7 | ||||
| -rw-r--r-- | gcc/fortran/misc.c | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_72.f90 | 83 |
3 files changed, 92 insertions, 8 deletions
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 219f04f..f5c88d9 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -5237,12 +5237,13 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag, /* In building an array constructor, gfortran can end up here when no conversion is required for an intrinsic type. We need to let derived types drop through. */ - if (from_ts.type != BT_DERIVED + if (from_ts.type != BT_DERIVED && from_ts.type != BT_CLASS && (from_ts.type == ts->type && from_ts.kind == ts->kind)) return true; - if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED - && gfc_compare_types (&expr->ts, ts)) + if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS) + && (ts->type == BT_DERIVED || ts->type == BT_CLASS) + && gfc_compare_types (ts, &expr->ts)) return true; /* If array is true then conversion is in an array constructor where diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index 3d449ae1..e6402e8 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -130,7 +130,6 @@ gfc_typename (gfc_typespec *ts, bool for_hash) static char buffer2[GFC_MAX_SYMBOL_LEN + 8]; static int flag = 0; char *buffer; - gfc_typespec *ts1; gfc_charlen_t length = 0; buffer = flag ? buffer1 : buffer2; @@ -180,16 +179,17 @@ gfc_typename (gfc_typespec *ts, bool for_hash) sprintf (buffer, "TYPE(%s)", ts->u.derived->name); break; case BT_CLASS: - if (ts->u.derived == NULL) + if (!ts->u.derived || !ts->u.derived->components + || !ts->u.derived->components->ts.u.derived) { sprintf (buffer, "invalid class"); break; } - ts1 = ts->u.derived->components ? &ts->u.derived->components->ts : NULL; - if (ts1 && ts1->u.derived && ts1->u.derived->attr.unlimited_polymorphic) + if (ts->u.derived->components->ts.u.derived->attr.unlimited_polymorphic) sprintf (buffer, "CLASS(*)"); else - sprintf (buffer, "CLASS(%s)", ts->u.derived->name); + sprintf (buffer, "CLASS(%s)", + ts->u.derived->components->ts.u.derived->name); break; case BT_ASSUMED: sprintf (buffer, "TYPE(*)"); diff --git a/gcc/testsuite/gfortran.dg/class_72.f90 b/gcc/testsuite/gfortran.dg/class_72.f90 new file mode 100644 index 0000000..0fd6ec0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_72.f90 @@ -0,0 +1,83 @@ +! PR fortran/102745 + +implicit none + +type t +end type t + +type, extends(t) :: t2 +end type t2 + +type t3 +end type t3 + +type(t), allocatable :: var +type(t2), allocatable :: v2ar +type(t3), allocatable :: v3ar +class(t), allocatable :: cvar +class(t2), allocatable :: c2var +class(t3), allocatable :: c3var + +call f(var) +call f(v2ar) ! { dg-error "passed TYPE.t2. to TYPE.t." } +call f(v2ar%t) +call f(cvar) +call f(c2var) ! { dg-error "passed CLASS.t2. to TYPE.t." } +call f(c2var%t) + +call f2(var) ! { dg-error "passed TYPE.t. to TYPE.t2." } +call f2(v2ar) +call f2(cvar) ! { dg-error "passed CLASS.t. to TYPE.t2." } +call f2(c2var) + + +var = var +var = v2ar ! { dg-error "TYPE.t2. to TYPE.t." } +var = cvar +var = c2var ! { dg-error "TYPE.t2. to TYPE.t." } + +v2ar = var ! { dg-error "Cannot convert TYPE.t. to TYPE.t2." } +v2ar = v2ar +v2ar = cvar ! { dg-error "Cannot convert TYPE.t. to TYPE.t2." } +v2ar = c2var + +cvar = var +cvar = v2ar +cvar = cvar +cvar = c2var + +c2var = var ! { dg-error "Cannot convert TYPE.t. to CLASS.t2." } +c2var = v3ar ! { dg-error "Cannot convert TYPE.t3. to CLASS.t2." } +c2var = v2ar +c2var = cvar ! { dg-error "Cannot convert CLASS.t. to CLASS.t2." } +c2var = c3var ! { dg-error "Cannot convert CLASS.t3. to CLASS.t2." } +c2var = c2var + +allocate (var, source=var) +allocate (var, source=v2ar) ! { dg-error "incompatible with source-expr" } +allocate (var, source=cvar) +allocate (var, source=c2var) ! { dg-error "incompatible with source-expr" } + +allocate (v2ar, source=var) ! { dg-error "incompatible with source-expr" } +allocate (v2ar, source=v2ar) +allocate (v2ar, source=cvar) ! { dg-error "incompatible with source-expr" } +allocate (v2ar, source=c2var) + +allocate (cvar, source=var) +allocate (cvar, source=v2ar) +allocate (cvar, source=cvar) +allocate (cvar, source=c2var) + +allocate (c2var, source=var) ! { dg-error "incompatible with source-expr" } +allocate (c2var, source=v2ar) +allocate (c2var, source=cvar) ! { dg-error "incompatible with source-expr" } +allocate (c2var, source=c2var) + +contains + subroutine f(x) + type(t) :: x + end + subroutine f2(x) + type(t2) :: x + end +end |