1! { dg-do compile }
2! Tests the fix for PR29321 and PR29322, in which ICEs occurred for the
3! lack of proper attention to checking pointers in gfc_conv_function_call.
4!
5! Contributed by Olav Vahtras  <vahtras@pdc.kth.se>
6! and Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
7!
8MODULE myint
9   TYPE NUM
10      INTEGER :: R = 0
11   END TYPE NUM
12   CONTAINS
13      FUNCTION FUNC(A,B) RESULT(E)
14      IMPLICIT NONE
15      TYPE(NUM)  A,B,E
16      INTENT(IN) ::  A,B
17      OPTIONAL B
18      E%R=A%R
19      CALL SUB(A,E)
20      END FUNCTION FUNC
21
22      SUBROUTINE SUB(A,E,B,C)
23      IMPLICIT NONE
24      TYPE(NUM) A,E,B,C
25      INTENT(IN)   A,B
26      INTENT(OUT)  E,C
27      OPTIONAL B,C
28      E%R=A%R
29      END SUBROUTINE SUB
30END MODULE myint
31
32  if (isscan () /= 0) call abort
33contains
34  integer function isscan (substr)
35    character(*), optional :: substr
36    if (.not.present(substr)) isscan = myscan ("foo", "over")
37  end function isscan
38end
39