gcc/testsuite/gfortran.dg/no_arg_check_2a.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/39505
   4 !
   5 ! Test NO_ARG_CHECK
   6 ! Copied from assumed_type_2.f90
   7 !
   8
   9 module mod
  10   use iso_c_binding, only: c_loc, c_ptr, c_bool
  11   implicit none
  12   interface my_c_loc
  13     function my_c_loc1(x) bind(C)
  14       import c_ptr
  15 !GCC$ attributes NO_ARG_CHECK :: x
  16       type(*) :: x
  17       type(c_ptr) :: my_c_loc1
  18     end function
  19   end interface my_c_loc
  20 contains
  21   subroutine sub_scalar (arg1, presnt)
  22      integer(8), target, optional :: arg1
  23      logical :: presnt
  24      type(c_ptr) :: cpt
  25 !GCC$ attributes NO_ARG_CHECK :: arg1
  26      if (presnt .neqv. present (arg1)) STOP 1
  27      cpt = c_loc (arg1)
  28   end subroutine sub_scalar
  29
  30   subroutine sub_array_assumed (arg3)
  31 !GCC$ attributes NO_ARG_CHECK :: arg3
  32      logical(1), target :: arg3(*)
  33      type(c_ptr) :: cpt
  34      cpt = c_loc (arg3)
  35   end subroutine sub_array_assumed
  36 end module
  37
  38 use mod
  39 use iso_c_binding, only: c_int, c_null_ptr
  40 implicit none
  41 type t1
  42   integer :: a
  43 end type t1
  44 type :: t2
  45   sequence
  46   integer :: b
  47 end type t2
  48 type, bind(C) :: t3
  49   integer(c_int) :: c
  50 end type t3
  51
  52 integer            :: scalar_int
  53 real, allocatable  :: scalar_real_alloc
  54 character, pointer :: scalar_char_ptr
  55
  56 integer            :: array_int(3)
  57 real, allocatable  :: array_real_alloc(:,:)
  58 character, pointer :: array_char_ptr(:,:)
  59
  60 type(t1)              :: scalar_t1
  61 type(t2), allocatable :: scalar_t2_alloc
  62 type(t3), pointer     :: scalar_t3_ptr
  63
  64 type(t1)              :: array_t1(4)
  65 type(t2), allocatable :: array_t2_alloc(:,:)
  66 type(t3), pointer     :: array_t3_ptr(:,:)
  67
  68 class(t1), allocatable :: scalar_class_t1_alloc
  69 class(t1), pointer     :: scalar_class_t1_ptr
  70
  71 class(t1), allocatable :: array_class_t1_alloc(:,:)
  72 class(t1), pointer     :: array_class_t1_ptr(:,:)
  73
  74 scalar_char_ptr => null()
  75 scalar_t3_ptr => null()
  76
  77 call sub_scalar (presnt=.false.)
  78 call sub_scalar (scalar_real_alloc, .false.)
  79 call sub_scalar (scalar_char_ptr, .false.)
  80 call sub_scalar (null (), .false.)
  81 call sub_scalar (scalar_t2_alloc, .false.)
  82 call sub_scalar (scalar_t3_ptr, .false.)
  83
  84 allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr)
  85 allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc)
  86 allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2))
  87 allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2))
  88 allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4))
  89
  90 call sub_scalar (scalar_int, .true.)
  91 call sub_scalar (scalar_real_alloc, .true.)
  92 call sub_scalar (scalar_char_ptr, .true.)
  93 call sub_scalar (array_int(2), .true.)
  94 call sub_scalar (array_real_alloc(3,2), .true.)
  95 call sub_scalar (array_char_ptr(0,1), .true.)
  96 call sub_scalar (scalar_t1, .true.)
  97 call sub_scalar (scalar_t2_alloc, .true.)
  98 call sub_scalar (scalar_t3_ptr, .true.)
  99 call sub_scalar (array_t1(2), .true.)
 100 call sub_scalar (array_t2_alloc(3,2), .true.)
 101 call sub_scalar (array_t3_ptr(0,1), .true.)
 102 call sub_scalar (array_class_t1_alloc(2,1), .true.)
 103 call sub_scalar (array_class_t1_ptr(3,3), .true.)
 104
 105 call sub_array_assumed (array_int)
 106 call sub_array_assumed (array_real_alloc)
 107 call sub_array_assumed (array_char_ptr)
 108 call sub_array_assumed (array_t1)
 109 call sub_array_assumed (array_t2_alloc)
 110 call sub_array_assumed (array_t3_ptr)
 111 call sub_array_assumed (array_class_t1_alloc)
 112 call sub_array_assumed (array_class_t1_ptr)
 113
 114 deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr)
 115 deallocate (array_class_t1_ptr, array_t3_ptr)
 116 contains
 117   subroutine sub(x)
 118     integer :: x(:)
 119     call sub_array_assumed (x)
 120   end subroutine sub
 121 end