bool lbound_OK = true;
bool ubound_OK = true;
+ if (contiguous)
+ *contiguous = false;
+
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
- return true;
+ {
+ if (contiguous)
+ *contiguous = true;
+ return true;
+ }
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
struct
{
gfc_actual_arglist* actual;
- gfc_typebound_proc* tbp;
const char* name;
+ void* padding; /* Overlap gfc_typebound_proc with esym. */
+ gfc_typebound_proc* tbp;
}
compcall;
e->value.function.actual = newactual;
e->value.function.name = e->value.compcall.name;
+ e->value.function.esym = target->n.sym;
e->value.function.isym = NULL;
- e->value.function.esym = NULL;
e->symtree = target;
e->ts = target->n.sym->ts;
e->expr_type = EXPR_FUNCTION;
/* The frontend doesn't seem to bother filling in expr->symtree for intrinsic
functions. */
- is_proc_ptr_comp(expr2, &comp);
gcc_assert (expr2->value.function.isym
- || (comp && comp->attr.dimension)
+ || (is_proc_ptr_comp (expr2, &comp)
+ && comp && comp->attr.dimension)
|| (!comp && gfc_return_by_reference (expr2->value.function.esym)
- && expr2->value.function.esym->result->attr.dimension));
+ && expr2->value.function.esym->result->attr.dimension));
ss = gfc_walk_expr (expr1);
gcc_assert (ss != gfc_ss_terminator);
--- /dev/null
+! { dg-do run }
+! Tests the fix for PR40646 in which the assignment would cause an ICE.
+!
+! Contributed by Charlie Sharpsteen <chuck@sharpsteen.net>
+! http://gcc.gnu.org/ml/fortran/2009-07/msg00010.html
+! and reported by Tobias Burnus <burnus@gcc,gnu.org>
+!
+module bugTestMod
+ implicit none
+ type:: boundTest
+ contains
+ procedure, nopass:: test => returnMat
+ end type boundTest
+contains
+ function returnMat( a, b ) result( mat )
+ integer:: a, b, i
+ double precision, dimension(a,b):: mat
+ mat = dble (reshape ([(i, i = 1, a * b)],[a,b]))
+ return
+ end function returnMat
+end module bugTestMod
+
+program bugTest
+ use bugTestMod
+ implicit none
+ integer i
+ double precision, dimension(2,2):: testCatch
+ type( boundTest ):: testObj
+ testCatch = testObj%test(2,2) ! This would cause an ICE
+ if (any (testCatch .ne. dble (reshape ([(i, i = 1, 4)],[2,2])))) call abort
+end program bugTest
+! { dg-final { cleanup-modules "bugTestMod" } }