gcc/testsuite/gfortran.dg/no_arg_check_2.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-O0 -fdump-tree-original" }
   3 !
   4 ! PR fortran/39505
   5 !
   6 ! Test NO_ARG_CHECK
   7 ! Copied from assumed_type_2.f90
   8 !
   9
  10 module mod
  11   use iso_c_binding, only: c_loc, c_ptr, c_bool
  12   implicit none
  13   interface my_c_loc
  14     function my_c_loc1(x) bind(C)
  15       import c_ptr
  16 !GCC$ attributes NO_ARG_CHECK :: x
  17       type(*) :: x
  18       type(c_ptr) :: my_c_loc1
  19     end function
  20   end interface my_c_loc
  21 contains
  22   subroutine sub_scalar (arg1, presnt)
  23      integer(8), target, optional :: arg1
  24      logical :: presnt
  25      type(c_ptr) :: cpt
  26 !GCC$ attributes NO_ARG_CHECK :: arg1
  27      if (presnt .neqv. present (arg1)) STOP 1
  28      cpt = c_loc (arg1)
  29   end subroutine sub_scalar
  30
  31   subroutine sub_array_assumed (arg3)
  32 !GCC$ attributes NO_ARG_CHECK :: arg3
  33      logical(1), target :: arg3(*)
  34      type(c_ptr) :: cpt
  35      cpt = c_loc (arg3)
  36   end subroutine sub_array_assumed
  37 end module
  38
  39 use mod
  40 use iso_c_binding, only: c_int, c_null_ptr
  41 implicit none
  42 type t1
  43   integer :: a
  44 end type t1
  45 type :: t2
  46   sequence
  47   integer :: b
  48 end type t2
  49 type, bind(C) :: t3
  50   integer(c_int) :: c
  51 end type t3
  52
  53 integer            :: scalar_int
  54 real, allocatable  :: scalar_real_alloc
  55 character, pointer :: scalar_char_ptr
  56
  57 integer            :: array_int(3)
  58 real, allocatable  :: array_real_alloc(:,:)
  59 character, pointer :: array_char_ptr(:,:)
  60
  61 type(t1)              :: scalar_t1
  62 type(t2), allocatable :: scalar_t2_alloc
  63 type(t3), pointer     :: scalar_t3_ptr
  64
  65 type(t1)              :: array_t1(4)
  66 type(t2), allocatable :: array_t2_alloc(:,:)
  67 type(t3), pointer     :: array_t3_ptr(:,:)
  68
  69 class(t1), allocatable :: scalar_class_t1_alloc
  70 class(t1), pointer     :: scalar_class_t1_ptr
  71
  72 class(t1), allocatable :: array_class_t1_alloc(:,:)
  73 class(t1), pointer     :: array_class_t1_ptr(:,:)
  74
  75 scalar_char_ptr => null()
  76 scalar_t3_ptr => null()
  77
  78 call sub_scalar (presnt=.false.)
  79 call sub_scalar (scalar_real_alloc, .false.)
  80 call sub_scalar (scalar_char_ptr, .false.)
  81 call sub_scalar (null (), .false.)
  82 call sub_scalar (scalar_t2_alloc, .false.)
  83 call sub_scalar (scalar_t3_ptr, .false.)
  84
  85 allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr)
  86 allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc)
  87 allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2))
  88 allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2))
  89 allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4))
  90
  91 call sub_scalar (scalar_int, .true.)
  92 call sub_scalar (scalar_real_alloc, .true.)
  93 call sub_scalar (scalar_char_ptr, .true.)
  94 call sub_scalar (array_int(2), .true.)
  95 call sub_scalar (array_real_alloc(3,2), .true.)
  96 call sub_scalar (array_char_ptr(0,1), .true.)
  97 call sub_scalar (scalar_t1, .true.)
  98 call sub_scalar (scalar_t2_alloc, .true.)
  99 call sub_scalar (scalar_t3_ptr, .true.)
 100 call sub_scalar (array_t1(2), .true.)
 101 call sub_scalar (array_t2_alloc(3,2), .true.)
 102 call sub_scalar (array_t3_ptr(0,1), .true.)
 103 call sub_scalar (array_class_t1_alloc(2,1), .true.)
 104 call sub_scalar (array_class_t1_ptr(3,3), .true.)
 105
 106 call sub_array_assumed (array_int)
 107 call sub_array_assumed (array_real_alloc)
 108 call sub_array_assumed (array_char_ptr)
 109 call sub_array_assumed (array_t1)
 110 call sub_array_assumed (array_t2_alloc)
 111 call sub_array_assumed (array_t3_ptr)
 112 call sub_array_assumed (array_class_t1_alloc)
 113 call sub_array_assumed (array_class_t1_ptr)
 114
 115 deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr)
 116 deallocate (array_class_t1_ptr, array_t3_ptr)
 117 contains
 118   subroutine sub(x)
 119     integer :: x(:)
 120     call sub_array_assumed (x)
 121   end subroutine sub
 122 end
 123
 124 ! { dg-final { scan-tree-dump-times "sub_scalar .0B,"  2 "original" } }
 125 ! { dg-final { scan-tree-dump-times "sub_scalar .scalar_real_alloc," 2 "original" } }
 126 ! { dg-final { scan-tree-dump-times "sub_scalar .scalar_char_ptr," 2 "original" } }
 127 ! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t2_alloc," 2 "original" } }
 128 ! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t3_ptr" 2 "original" } }
 129
 130 ! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_int," 1 "original" } }
 131 ! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
 132 ! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } }
 133 ! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
 134
 135 ! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } }
 136 ! { dg-final { scan-tree-dump-times "sub_scalar .\\(character.kind=1..1:1. .\\) .array_char_ptr.data" 1 "original" } }
 137 ! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } }
 138 ! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t3 .\\) .array_t3_ptr.data" 1 "original" } }
 139 ! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } }
 140 ! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.dat" 1 "original" } }
 141
 142 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 4 "original" } }
 143 ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } }
 144 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } }
 145 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } }
 146 ! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } }
 147 ! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } }
 148 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } }
 149 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } }
 150 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } }
 151 ! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 0 "original" } }
 152