}
}
else if (field->expr_type == EXPR_ARRAY)
- e = gfc_copy_expr (field_ctor->expr);
+ {
+ if (field_ctor)
+ e = gfc_copy_expr (field_ctor->expr);
+ else
+ {
+ /* Not enough elements in array FIELD. */
+ gfc_free_expr (result);
+ return &gfc_bad_expr;
+ }
+ }
else
e = gfc_copy_expr (field);
--- /dev/null
+! { dg-do compile }
+! PR fortran/107922 - ICE in gfc_simplify_unpack
+! Test error recovery when shapes of FIELD and MASK do not match
+! Contributed by G.Steinmetz
+
+program p
+ integer, parameter :: a(2) = 1
+ integer, parameter :: d(3) = 1
+ logical, parameter :: mask(3) = [.false.,.true.,.false.]
+ integer, parameter :: b(2) = unpack(a,mask,a) ! { dg-error "must have identical shape" }
+ integer :: c(3) = unpack(a,[.false.,.true.,.false.],a) ! { dg-error "must have identical shape" }
+ print *, unpack(a,mask,a) ! { dg-error "must have identical shape" }
+ print *, unpack(a,mask,d) ! OK
+ print *, unpack(a,mask,3) ! OK
+end