gcc/testsuite/gfortran.dg/argument_checking_11.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=f95 -fmax-errors=100" }
   3 !
   4 ! PR fortran/34665
   5 !
   6 ! Test argument checking
   7 !
   8 ! TODO: Check also expressions, e.g. "(a(1))" instead of "a(1)
   9 ! for strings; check also "string" and [ "string" ]
  10 !
  11 implicit none
  12 CONTAINS
  13 SUBROUTINE test1(a,b,c,d,e)
  14  integer, dimension(:) :: a
  15  integer, pointer, dimension(:) :: b
  16  integer, dimension(*) :: c
  17  integer, dimension(5) :: d
  18  integer               :: e
  19
  20  call as_size(a)
  21  call as_size(b)
  22  call as_size(c)
  23  call as_size(d)
  24  call as_size(e) ! { dg-error "Rank mismatch" }
  25  call as_size(1) ! { dg-error "Rank mismatch" }
  26  call as_size( (/ 1 /) )
  27  call as_size( (a) )
  28  call as_size( (b) )
  29  call as_size( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
  30  call as_size( (d) )
  31  call as_size( (e) ) ! { dg-error "Rank mismatch" }
  32  call as_size(a(1)) ! { dg-error "Element of assumed-shape" }
  33  call as_size(b(1)) ! { dg-error "Element of assumed-shape" }
  34  call as_size(c(1))
  35  call as_size(d(1))
  36  call as_size( (a(1)) ) ! { dg-error "Rank mismatch" }
  37  call as_size( (b(1)) ) ! { dg-error "Rank mismatch" }
  38  call as_size( (c(1)) ) ! { dg-error "Rank mismatch" }
  39  call as_size( (d(1)) ) ! { dg-error "Rank mismatch" }
  40  call as_size(a(1:2))
  41  call as_size(b(1:2))
  42  call as_size(c(1:2))
  43  call as_size(d(1:2))
  44  call as_size( (a(1:2)) )
  45  call as_size( (b(1:2)) )
  46  call as_size( (c(1:2)) )
  47  call as_size( (d(1:2)) )
  48
  49  call as_shape(a)
  50  call as_shape(b)
  51  call as_shape(c) ! { dg-error "cannot be an assumed-size array" }
  52  call as_shape(d)
  53  call as_shape(e) ! { dg-error "Rank mismatch" }
  54  call as_shape( 1 ) ! { dg-error "Rank mismatch" }
  55  call as_shape( (/ 1 /) )
  56  call as_shape( (a) )
  57  call as_shape( (b) )
  58  call as_shape( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
  59  call as_shape( (d) )
  60  call as_shape( (e) ) ! { dg-error "Rank mismatch" }
  61  call as_shape( (1) ) ! { dg-error "Rank mismatch" }
  62  call as_shape( ((/ 1 /)) )
  63  call as_shape(a(1)) ! { dg-error "Rank mismatch" }
  64  call as_shape(b(1)) ! { dg-error "Rank mismatch" }
  65  call as_shape(c(1)) ! { dg-error "Rank mismatch" }
  66  call as_shape(d(1)) ! { dg-error "Rank mismatch" }
  67  call as_shape( (a(1)) ) ! { dg-error "Rank mismatch" }
  68  call as_shape( (b(1)) ) ! { dg-error "Rank mismatch" }
  69  call as_shape( (c(1)) ) ! { dg-error "Rank mismatch" }
  70  call as_shape( (d(1)) ) ! { dg-error "Rank mismatch" }
  71  call as_shape(a(1:2))
  72  call as_shape(b(1:2))
  73  call as_shape(c(1:2))
  74  call as_shape(d(1:2))
  75  call as_shape( (a(1:2)) )
  76  call as_shape( (b(1:2)) )
  77  call as_shape( (c(1:2)) )
  78  call as_shape( (d(1:2)) )
  79
  80  call as_expl(a)
  81  call as_expl(b)
  82  call as_expl(c)
  83  call as_expl(d)
  84  call as_expl(e) ! { dg-error "Rank mismatch" }
  85  call as_expl( 1 ) ! { dg-error "Rank mismatch" }
  86  call as_expl( (/ 1, 2, 3 /) )
  87  call as_expl( (a) )
  88  call as_expl( (b) )
  89  call as_expl( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
  90  call as_expl( (d) )
  91  call as_expl( (e) ) ! { dg-error "Rank mismatch" }
  92  call as_expl(a(1)) ! { dg-error "Element of assumed-shape" }
  93  call as_expl(b(1)) ! { dg-error "Element of assumed-shape" }
  94  call as_expl(c(1))
  95  call as_expl(d(1))
  96  call as_expl( (a(1)) ) ! { dg-error "Rank mismatch" }
  97  call as_expl( (b(1)) ) ! { dg-error "Rank mismatch" }
  98  call as_expl( (c(1)) ) ! { dg-error "Rank mismatch" }
  99  call as_expl( (d(1)) )  ! { dg-error "Rank mismatch" }
 100  call as_expl(a(1:3))
 101  call as_expl(b(1:3))
 102  call as_expl(c(1:3))
 103  call as_expl(d(1:3))
 104  call as_expl( (a(1:3)) )
 105  call as_expl( (b(1:3)) )
 106  call as_expl( (c(1:3)) )
 107  call as_expl( (d(1:3)) )
 108 END SUBROUTINE test1
 109
 110 SUBROUTINE as_size(a)
 111  integer, dimension(*) :: a
 112 END SUBROUTINE as_size
 113
 114 SUBROUTINE as_shape(a)
 115  integer, dimension(:) :: a
 116 END SUBROUTINE as_shape
 117
 118 SUBROUTINE as_expl(a)
 119  integer, dimension(3) :: a
 120 END SUBROUTINE as_expl
 121
 122
 123 SUBROUTINE test2(a,b,c,d,e)
 124  character(len=*), dimension(:) :: a
 125  character(len=*), pointer, dimension(:) :: b
 126  character(len=*), dimension(*) :: c
 127  character(len=*), dimension(5) :: d
 128  character(len=*)               :: e
 129
 130  call cas_size(a)
 131  call cas_size(b)
 132  call cas_size(c)
 133  call cas_size(d)
 134  call cas_size(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 135  call cas_size("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 136  call cas_size( (/"abc"/) )
 137  call cas_size(a//"a")
 138  call cas_size(b//"a")
 139  call cas_size(c//"a")  ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
 140  call cas_size(d//"a")
 141  call cas_size(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 142  call cas_size(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 143  call cas_size( ((/"abc"/)) )
 144  call cas_size(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 145  call cas_size(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 146  call cas_size(c(1)) ! OK in F95
 147  call cas_size(d(1)) ! OK in F95
 148  call cas_size((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 149  call cas_size((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 150  call cas_size((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 151  call cas_size((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 152  call cas_size(a(1:2))
 153  call cas_size(b(1:2))
 154  call cas_size(c(1:2))
 155  call cas_size(d(1:2))
 156  call cas_size((a(1:2)//"a"))
 157  call cas_size((b(1:2)//"a"))
 158  call cas_size((c(1:2)//"a"))
 159  call cas_size((d(1:2)//"a"))
 160  call cas_size(a(:)(1:3))
 161  call cas_size(b(:)(1:3))
 162  call cas_size(d(:)(1:3))
 163  call cas_size((a(:)(1:3)//"a"))
 164  call cas_size((b(:)(1:3)//"a"))
 165  call cas_size((d(:)(1:3)//"a"))
 166  call cas_size(a(1:2)(1:3))
 167  call cas_size(b(1:2)(1:3))
 168  call cas_size(c(1:2)(1:3))
 169  call cas_size(d(1:2)(1:3))
 170  call cas_size((a(1:2)(1:3)//"a"))
 171  call cas_size((b(1:2)(1:3)//"a"))
 172  call cas_size((c(1:2)(1:3)//"a"))
 173  call cas_size((d(1:2)(1:3)//"a"))
 174  call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 175  call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 176  call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 177  call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 178
 179  call cas_shape(a)
 180  call cas_shape(b)
 181  call cas_shape(c) ! { dg-error "cannot be an assumed-size array" }
 182  call cas_shape(d)
 183  call cas_shape(e) ! { dg-error "Rank mismatch" }
 184  call cas_shape("abc") ! { dg-error "Rank mismatch" }
 185  call cas_shape( (/"abc"/) )
 186  call cas_shape(a//"c")
 187  call cas_shape(b//"c")
 188  call cas_shape(c//"c") ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
 189  call cas_shape(d//"c")
 190  call cas_shape(e//"c") ! { dg-error "Rank mismatch" }
 191  call cas_shape(("abc")) ! { dg-error "Rank mismatch" }
 192  call cas_shape( ((/"abc"/)) )
 193  call cas_shape(a(1)) ! { dg-error "Rank mismatch" }
 194  call cas_shape(b(1)) ! { dg-error "Rank mismatch" }
 195  call cas_shape(c(1)) ! { dg-error "Rank mismatch" }
 196  call cas_shape(d(1)) ! { dg-error "Rank mismatch" }
 197  call cas_shape(a(1:2))
 198  call cas_shape(b(1:2))
 199  call cas_shape(c(1:2))
 200  call cas_shape(d(1:2))
 201  call cas_shape((a(1:2)//"a"))
 202  call cas_shape((b(1:2)//"a"))
 203  call cas_shape((c(1:2)//"a"))
 204  call cas_shape((d(1:2)//"a"))
 205  call cas_shape(a(:)(1:3))
 206  call cas_shape(b(:)(1:3))
 207  call cas_shape(d(:)(1:3))
 208  call cas_shape((a(:)(1:3)//"a"))
 209  call cas_shape((b(:)(1:3)//"a"))
 210  call cas_shape((d(:)(1:3)//"a"))
 211  call cas_shape(a(1:2)(1:3))
 212  call cas_shape(b(1:2)(1:3))
 213  call cas_shape(c(1:2)(1:3))
 214  call cas_shape(d(1:2)(1:3))
 215  call cas_shape((a(1:2)(1:3)//"a"))
 216  call cas_shape((b(1:2)(1:3)//"a"))
 217  call cas_shape((c(1:2)(1:3)//"a"))
 218  call cas_shape((d(1:2)(1:3)//"a"))
 219  call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 220  call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 221  call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 222  call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 223
 224  call cas_expl(a)
 225  call cas_expl(b)
 226  call cas_expl(c)
 227  call cas_expl(d)
 228  call cas_expl(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 229  call cas_expl("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 230  call cas_expl((/"a","b","c"/))
 231  call cas_expl(a//"a")
 232  call cas_expl(b//"a")
 233  call cas_expl(c//"a")  ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
 234  call cas_expl(d//"a")
 235  call cas_expl(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 236  call cas_expl(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 237  call cas_expl(((/"a","b","c"/)))
 238  call cas_expl(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 239  call cas_expl(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 240  call cas_expl(c(1)) ! OK in F95
 241  call cas_expl(d(1)) ! OK in F95
 242  call cas_expl((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 243  call cas_expl((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 244  call cas_expl((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 245  call cas_expl((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 246  call cas_expl(a(1:3))
 247  call cas_expl(b(1:3))
 248  call cas_expl(c(1:3))
 249  call cas_expl(d(1:3))
 250  call cas_expl((a(1:3)//"a"))
 251  call cas_expl((b(1:3)//"a"))
 252  call cas_expl((c(1:3)//"a"))
 253  call cas_expl((d(1:3)//"a"))
 254  call cas_expl(a(:)(1:3))
 255  call cas_expl(b(:)(1:3))
 256  call cas_expl(d(:)(1:3))
 257  call cas_expl((a(:)(1:3)))
 258  call cas_expl((b(:)(1:3)))
 259  call cas_expl((d(:)(1:3)))
 260  call cas_expl(a(1:2)(1:3))
 261  call cas_expl(b(1:2)(1:3))
 262  call cas_expl(c(1:2)(1:3))
 263  call cas_expl(d(1:2)(1:3))
 264  call cas_expl((a(1:2)(1:3)//"a"))
 265  call cas_expl((b(1:2)(1:3)//"a"))
 266  call cas_expl((c(1:2)(1:3)//"a"))
 267  call cas_expl((d(1:2)(1:3)//"a"))
 268  call cas_expl(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 269  call cas_expl("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 270  call cas_expl((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 271  call cas_expl(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
 272 END SUBROUTINE test2
 273
 274 SUBROUTINE cas_size(a)
 275  character(len=*), dimension(*) :: a
 276 END SUBROUTINE cas_size
 277
 278 SUBROUTINE cas_shape(a)
 279  character(len=*), dimension(:) :: a
 280 END SUBROUTINE cas_shape
 281
 282 SUBROUTINE cas_expl(a)
 283  character(len=*), dimension(3) :: a
 284 END SUBROUTINE cas_expl
 285 END