1! { dg-do compile }
2! { dg-options "-pedantic -fwhole-file" }
3!
4! Tests the fix for PR25087, in which the following invalid code
5! was not detected.
6!
7! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
8!
9! Modified by Tobias Burnus to fix PR fortran/41235.
10!
11FUNCTION a()
12  CHARACTER(len=10) :: a
13  a = ''
14END FUNCTION a
15
16SUBROUTINE s(n)
17  CHARACTER(LEN=n), EXTERNAL :: a  ! { dg-error "Character length mismatch" }
18  CHARACTER(LEN=n), EXTERNAL :: d  ! { dg-error "Character length mismatch" }
19  interface
20    function b (m)                ! This is OK
21      CHARACTER(LEN=m) :: b
22      integer :: m
23    end function b
24  end interface
25  write(6,*) a()
26  write(6,*) b(n)
27  write(6,*) c()
28  write(6,*) d()
29contains
30    function c ()                ! This is OK
31      CHARACTER(LEN=n):: c
32      c = ""
33    end function c
34END SUBROUTINE s
35
36FUNCTION d()
37  CHARACTER(len=99) :: d
38  d = ''
39END FUNCTION d
40