===================================================================
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
goto cleanup;
! if (!tmp->ts.u.cl->length
! || tmp->ts.u.cl->length->expr_type != EXPR_CONSTANT)
goto cleanup;
- *newp = gfc_copy_expr (tmp->ts.u.cl->length);
break;
case INQUIRY_KIND:
if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C"))
goto cleanup;
! if (tmp->ts.u.cl->length
! && tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT)
! *newp = gfc_copy_expr (tmp->ts.u.cl->length);
! else if (tmp->expr_type == EXPR_CONSTANT)
! *newp = gfc_get_int_expr (gfc_default_integer_kind,
! NULL, tmp->value.character.length);
! else
goto cleanup;
break;
case INQUIRY_KIND:
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_realref (p->value.complex), GFC_RND_MODE);
break;
case INQUIRY_IM:
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_realref (tmp->value.complex), GFC_RND_MODE);
break;
case INQUIRY_IM:
*************** find_inquiry_ref (gfc_expr *p, gfc_expr
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_imagref (p->value.complex), GFC_RND_MODE);
break;
}
tmp = gfc_copy_expr (*newp);
*newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where);
mpfr_set ((*newp)->value.real,
! mpc_imagref (tmp->value.complex), GFC_RND_MODE);
break;
}
tmp = gfc_copy_expr (*newp);
===================================================================
***************
+ ! { dg-do run }
+ !
+ ! Test the fix for pr92753
+ !
+ ! Contributed by Gerhardt Steinmetz <gscfq@t-online.de>
+ !
+ module m
+ type t
+ character(3) :: c
+ end type
+ type u
+ complex :: z
+ end type
+ type(t), parameter :: x = t ('abc')
+ integer, parameter :: l = x%c%len ! Used to ICE
+
+ type(u), parameter :: z = u ((42.0,-42.0))
+ end
+ program p
+ use m
+ call s (x%c%len) ! ditto
+
+ if (int (z%z%re) .ne. 42) stop 1 ! Produced wrong code and
+ if (int (z%z%re) .ne. -int (z%z%im)) stop 2 ! runtime seg fault
+ contains
+ subroutine s(n)
+ if (n .ne. l) stop 3
+ end
+ end