view gcc/testsuite/gfortran.dg/no_arg_check_3.f90 @ 128:fe568345ddd5

fix CbC-example
author mir3636
date Wed, 11 Apr 2018 19:32:28 +0900
parents 04ced10e8804
children
line wrap: on
line source

! { dg-do compile }
! { dg-options "-fcoarray=single" }
!
! PR fortran/39505
! 
! Test NO_ARG_CHECK
! Copied from assumed_type_2.f90
!
subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
  integer, value :: a
end subroutine one

subroutine two(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
  integer, pointer :: a
end subroutine two

subroutine three(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
  integer, allocatable :: a
end subroutine three

subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
!GCC$ attributes NO_ARG_CHECK :: a
  integer  :: a[*]
end subroutine four

subroutine five(a) ! { dg-error "with NO_ARG_CHECK attribute shall either be a scalar or an assumed-size array" }
!GCC$ attributes NO_ARG_CHECK :: a
  integer :: a(3)
end subroutine five

subroutine six()
!GCC$ attributes NO_ARG_CHECK :: nodum ! { dg-error "with NO_ARG_CHECK attribute shall be a dummy argument" }
  integer :: nodum
end subroutine six

subroutine seven(y)
!GCC$ attributes NO_ARG_CHECK :: y
 integer :: y(*)
 call a7(y(3:5)) ! { dg-error "with NO_ARG_CHECK attribute shall not have a subobject reference" }
contains
 subroutine a7(x)
!GCC$ attributes NO_ARG_CHECK :: x
   integer :: x(*)
 end subroutine a7
end subroutine seven

subroutine nine()
  interface one
    subroutine okay(x)
!GCC$ attributes NO_ARG_CHECK :: x
      integer :: x
    end subroutine okay
  end interface
  interface two
    subroutine ambig1(x)  ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
      integer :: x
    end subroutine ambig1
    subroutine ambig2(x)  ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
      integer :: x(*)
    end subroutine ambig2
  end interface
  interface three
    subroutine ambig3(x)   ! { dg-error "Ambiguous interfaces" }
!GCC$ attributes NO_ARG_CHECK :: x
      integer :: x
    end subroutine ambig3
    subroutine ambig4(x)   ! { dg-error "Ambiguous interfaces" }
      integer :: x
    end subroutine ambig4
  end interface
end subroutine nine

subroutine ten()
 interface
   subroutine bar()
   end subroutine
 end interface
 type t
 contains
   procedure, nopass :: proc => bar
 end type
 type(t) :: xx
 call sub(xx) ! { dg-error "is of derived type with type-bound or FINAL procedures" }
contains
  subroutine sub(a)
!GCC$ attributes NO_ARG_CHECK :: a
    integer :: a
  end subroutine sub
end subroutine ten

subroutine eleven(x)
  external bar
!GCC$ attributes NO_ARG_CHECK :: x
  integer :: x
  call bar(x) ! { dg-error "Assumed-type argument x at .1. requires an explicit interface" }
end subroutine eleven

subroutine twelf(x)
!GCC$ attributes NO_ARG_CHECK :: x
  integer :: x
  call bar(x) ! { dg-error "Type mismatch in argument" }
contains
  subroutine bar(x)
    integer :: x
  end subroutine bar
end subroutine twelf

subroutine thirteen(x, y)
!GCC$ attributes NO_ARG_CHECK :: x
  integer :: x
  integer :: y(:)
  print *, ubound(y, dim=x) ! { dg-error "Variable with NO_ARG_CHECK attribute at .1. is only permitted as argument to the intrinsic functions C_LOC and PRESENT" }
end subroutine thirteen

subroutine fourteen(x)
!GCC$ attributes NO_ARG_CHECK :: x
  integer :: x
  x = x ! { dg-error "with NO_ARG_CHECK attribute may only be used as actual argument" }
end subroutine fourteen