1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
! { dg-do compile }
!
! PR 35831: [F95] Shape mismatch check missing for dummy procedure argument
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
implicit none
call call_a(a1) ! { dg-error "Character length mismatch in function result" }
call call_b(b1) ! { dg-error "Shape mismatch" }
call call_c(c1) ! { dg-error "POINTER attribute mismatch in function result" }
call call_d(c1) ! { dg-error "ALLOCATABLE attribute mismatch in function result" }
call call_e(e1) ! { dg-error "CONTIGUOUS attribute mismatch in function result" }
call call_f(c1) ! { dg-error "PROCEDURE POINTER mismatch in function result" }
contains
character(1) function a1()
end function
subroutine call_a(a3)
interface
character(2) function a3()
end function
end interface
end subroutine
function b1()
integer, dimension(1:3) :: b1
end function
subroutine call_b(b2)
interface
function b2()
integer, dimension(0:4) :: b2
end function
end interface
end subroutine
integer function c1()
end function
subroutine call_c(c2)
interface
function c2()
integer, pointer :: c2
end function
end interface
end subroutine
subroutine call_d(d2)
interface
function d2()
integer, allocatable :: d2
end function
end interface
end subroutine
function e1()
integer, dimension(:), pointer :: e1
end function
subroutine call_e(e2)
interface
function e2()
integer, dimension(:), pointer, contiguous :: e2
end function
end interface
end subroutine
subroutine call_f(f2)
interface
function f2()
procedure(integer), pointer :: f2
end function
end interface
end subroutine
end
|
