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
85
86
87
|
! { dg-shouldfail "error directive" }
module m
implicit none (external, type)
contains
integer function foo (i, x)
integer, value :: i, x
if (x /= 0) then
!$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
i = i + 1
end if
if (x /= 0) then
! ...
else
!$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
i = i + 2
end if
select case(0)
!$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
case default
!
end select
do while (.false.)
!$omp error message("42 - 1") severity (warning) ! { dg-warning ".OMP ERROR encountered at .1.: 42 - 1" }
i = i + 4
end do
99 continue
!$omp error severity(warning) message("bar") at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: bar" }
i = i + 8
foo = i
end function
end module
program main
use m
implicit none (external, type)
character(len=13) :: msg
character(len=:), allocatable :: msg2, msg3
! Initialize offloading early, so that any output this may produce doesn't
! disturb the 'dg-output' scanning below.
!$omp target
!$omp end target
msg = "my message"
if (foo (5, 0) /= 15 .or. foo (7, 1) /= 16) &
stop 1
msg2 = "Paris"
msg3 = "To thine own self be true"
call bar ("Polonius", "Laertes", msg2, msg3)
msg2 = "Hello World"
!$omp error at (execution) severity (warning)
!$omp error at (execution) severity (warning) message(trim(msg(4:)))
!$omp error at (execution) severity (warning) message ("Farewell")
!$omp target
!$omp error at (execution) severity (warning) message ("ffrom a distanceee"(2:16))
!$omp end target
!$omp error at (execution) severity (warning) message (msg2)
!$omp error at (execution) severity (warning) message (msg(4:6))
!$omp error at (execution) severity (fatal) message (msg)
! unreachable due to 'fatal'---------^
!$omp error at (execution) severity (warning) message ("foobar")
contains
subroutine bar(x, y, a, b)
character(len=*) :: x, y
character(len=:), allocatable :: a, b
optional :: y, b
intent(in) :: x, y, a, b
!$omp error at (execution) severity (warning) message (x)
!$omp error at (execution) severity (warning) message (y)
!$omp error at (execution) severity (warning) message (a)
!$omp error at (execution) severity (warning) message (b)
end subroutine
end
! { dg-output "(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: Polonius(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: Laertes(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: Paris(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: To thine own self be true(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: message(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: Farewell(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: from a distance(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: Hello World(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: error directive encountered: mes(\n|\r|\r\n)(\n|\r|\r\n)" }
! { dg-output "libgomp: fatal error: error directive encountered: my message (\n|\r|\r\n)" }
|
