1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! Test the fix for PR64932.
5!
6! Reported by Daniel Shapiro  <shapero@uw.edu>
7!
8module coo_graphs
9  implicit none
10  type :: dynamic_array
11    integer :: length, capacity, min_capacity
12    integer, allocatable :: array(:)
13  end type
14  type :: coo_graph
15    type(dynamic_array) :: edges(2)
16    integer, private :: ne
17  end type coo_graph
18contains
19  subroutine coo_dump_edges(g, edges)
20    class(coo_graph), intent(in) :: g
21    integer, intent(out) :: edges(:,:)
22  end subroutine coo_dump_edges
23end module coo_graphs
24! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
25! { dg-final { cleanup-tree-dump "original" } }
26