1! { dg-do compile }
2! { dg-options "-Wunused-variable -Wunused-parameter" }
3! This tests the fix for PR18111 in which some artificial declarations
4! were being listed as unused parameters:
5! (i) Array dummies, where a copy is made;
6! (ii) The dummies of "entry thunks" (ie. the articial procedures that
7! represent ENTRYs and call the "entry_master" function; and
8! (iii) The __entry parameter of the entry_master function, which
9! indentifies the calling entry thunk.
10! All of these have DECL_ARTIFICIAL (tree) set.
11!
12! Contributed by Paul Thomas  <pault@gcc.gnu.org>
13!
14module foo
15  implicit none
16contains
17
18!This is the original problem
19
20  subroutine bar(arg1, arg2, arg3, arg4, arg5)
21    character(len=80), intent(in) :: arg1
22    character(len=80), dimension(:), intent(in) :: arg2
23    integer, dimension(arg4), intent(in) :: arg3
24    integer, intent(in) :: arg4
25    character(len=arg4), intent(in) :: arg5
26    print *, arg1, arg2, arg3, arg4, arg5
27  end subroutine bar
28
29! This ICED with the first version of the fix because gfc_build_dummy_array_decl
30! sometimes NULLS sym->backend_decl; taken from aliasing_dummy_1.f90
31
32  subroutine foo1 (slist, i)
33    character(*), dimension(*) :: slist
34    integer i
35    write (slist(i), '(2hi=,i3)') i
36  end subroutine foo1
37
38! This tests the additions to the fix that prevent the dummies of entry thunks
39! and entry_master __entry parameters from being listed as unused.
40
41  function f1 (a)
42    integer, dimension (2, 2) :: a, b, f1, e1
43    f1 (:, :) = 15 + a
44    return
45  entry e1 (b)
46    e1 (:, :) = 42 + b
47  end function
48
49end module foo
50