gcc/testsuite/gfortran.dg/proc_decl_1.f90

! { dg-do compile }
! { dg-options "-std=legacy" }
!
! This tests various error messages for PROCEDURE declarations.
! Contributed by Janus Weil <jaydub66@gmail.com>

module m

  abstract interface
    subroutine sub()
    end subroutine
    subroutine sub2() bind(c)
    end subroutine
  end interface

  procedure(), public, private :: a  ! { dg-error "was already specified" }
  procedure(sub),bind(C) :: a2  ! { dg-error "requires an interface with BIND.C." }
  procedure(sub2), public, bind(c, name="myEF") :: e, f  ! { dg-error "Multiple identifiers provided with single NAME= specifier" }
  procedure(sub2), bind(C, name=""), pointer :: g  ! { dg-error "may not have POINTER attribute" }

  public:: h
  procedure(),public:: h  ! { dg-error "was already specified" }

contains

  subroutine abc
    procedure() :: abc2
  entry abc2(x)  ! { dg-error "PROCEDURE attribute conflicts with ENTRY attribute" }
    real x
  end subroutine

end module m

program prog

  interface z
    subroutine z1()
    end subroutine
    subroutine z2(a)
      integer :: a
    end subroutine
  end interface

  procedure(z) :: bar   ! { dg-error "may not be generic" }

  procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
  procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }

  procedure(dcos) :: my1
  procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }

  real f, x
  f(x) = sin(x**2)
  external oo

  procedure(f) :: q  ! { dg-error "may not be a statement function" }
  procedure(oo) :: p  ! { dg-error "must be explicit" }

  procedure ( ) :: r 
  procedure ( up ) :: s  ! { dg-error "must be explicit" }

  procedure(t) :: t  ! { dg-error "may not be used as its own interface" }

  call s

contains

  subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
    abstract interface
      subroutine b() bind(C)
      end subroutine b
    end interface
    procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
    procedure(b),intent(in):: c
  end subroutine foo 

end program