1! { dg-do compile }
2!
3! PR fortran/99111
4!
5program p
6   use iso_c_binding
7   implicit none
8   type t
9      integer :: a(1)
10   end type
11   type(t), parameter :: x(3) = [t(transfer('("he', 1)), &
12                                 t(transfer('llo ', 1)), &
13                                 t(transfer('W1")', 1))]
14   type t2
15     procedure(), pointer, nopass :: ppt
16   end type t2
17   type(t2) :: ppcomp(1)
18   interface
19     function fptr()
20       procedure(), pointer :: fptr
21     end function
22   end interface
23   class(t), allocatable :: cl(:)
24   type(c_ptr) :: cptr(1)
25   type(c_funptr) :: cfunptr(1)
26   procedure(), pointer :: proc
27   external proc2
28
29   print x ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
30   print cl ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
31   print cptr ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
32   print cfunptr ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
33
34   print proc ! { dg-error "Syntax error in PRINT statement" }
35   print proc2 ! { dg-error "Syntax error in PRINT statement" }
36   print ppcomp%ppt ! { dg-error "Syntax error in PRINT statement" }
37
38   print fptr() ! { dg-error "must be of type default-kind CHARACTER or of INTEGER" }
39
40   call bar(1)
41contains
42   subroutine bar (xx)
43     type(*) :: xx
44     print xx  ! { dg-error "Assumed-type variable xx at ... may only be used as actual argument" }
45   end
46end
47