flang/test/Semantics/io11.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2
   3 ! Tests for defined input/output.  See 12.6.4.8 and 15.4.3.2, and C777
   4 module m1
   5   type,public :: t
   6     integer c
   7   contains
   8     procedure, nopass :: tbp=>formattedReadProc !Error, NOPASS not allowed
   9     !ERROR: Defined input/output procedure 'tbp' may not have NOPASS attribute
  10     generic :: read(formatted) => tbp
  11   end type
  12   private
  13 contains
  14   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
  15     class(t), intent(inout) :: dtv
  16     integer, intent(in) :: unit
  17     character(len=*), intent(in) :: iotype
  18     integer, intent(in) :: vlist(:)
  19     integer, intent(out) :: iostat
  20     character(len=*), intent(inout) :: iomsg
  21
  22     iostat = 343
  23     stop 'fail'
  24   end subroutine
  25 end module m1
  26
  27 module m2
  28   type,public :: t
  29     integer c
  30   contains
  31     procedure, pass :: tbp=>formattedReadProc
  32     !ERROR: Defined input/output procedure 'formattedreadproc' must have 6 dummy arguments rather than 5
  33     generic :: read(formatted) => tbp
  34   end type
  35   private
  36 contains
  37   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat)
  38     class(t), intent(inout) :: dtv
  39     integer, intent(in) :: unit
  40     character(len=*), intent(in) :: iotype
  41     integer, intent(in) :: vlist(:)
  42     integer, intent(out) :: iostat
  43
  44     iostat = 343
  45     stop 'fail'
  46   end subroutine
  47 end module m2
  48
  49 module m3
  50   type,public :: t
  51     integer c
  52   contains
  53     procedure, pass :: tbp=>unformattedReadProc
  54     !ERROR: Defined input/output procedure 'unformattedreadproc' must have 4 dummy arguments rather than 5
  55     generic :: read(unformatted) => tbp
  56   end type
  57   private
  58 contains
  59   ! Error bad # of args
  60   subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
  61     class(t), intent(inout) :: dtv
  62     integer, intent(in) :: unit
  63     integer, intent(out) :: iostat
  64     character(len=*), intent(inout) :: iomsg
  65     integer, intent(out) :: iotype
  66
  67     iostat = 343
  68     stop 'fail'
  69   end subroutine
  70 end module m3
  71
  72 module m4
  73   type,public :: t
  74     integer c
  75   contains
  76     procedure, pass :: tbp=>formattedReadProc
  77     generic :: read(formatted) => tbp
  78   end type
  79   private
  80 contains
  81   !ERROR: Dummy argument 0 of 'formattedreadproc' must be a data object
  82   !ERROR: Cannot use an alternate return as the passed-object dummy argument
  83   subroutine formattedReadProc(*, unit, iotype, vlist, iostat, iomsg)
  84     !ERROR: Dummy argument 'unit' must be a data object
  85     !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
  86     procedure(sin), intent(in) :: unit
  87     character(len=*), intent(in) :: iotype
  88     integer, intent(in) :: vlist(:)
  89     integer, intent(out) :: iostat
  90     character(len=*), intent(inout) :: iomsg
  91
  92     iostat = 343
  93     stop 'fail'
  94   end subroutine
  95 end module m4
  96
  97 module m5
  98   type,public :: t
  99     integer c
 100   contains
 101     !ERROR: Passed-object dummy argument 'dtv' of procedure 'tbp' must be of type 't' but is 'INTEGER(4)'
 102     procedure, pass :: tbp=>formattedReadProc
 103     generic :: read(formatted) => tbp
 104   end type
 105   private
 106 contains
 107   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 108     !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have a derived type
 109     integer, intent(inout) :: dtv ! error, must be of type t
 110     integer, intent(in) :: unit
 111     character(len=*), intent(in) :: iotype
 112     integer, intent(in) :: vlist(:)
 113     integer, intent(out) :: iostat
 114     character(len=*), intent(inout) :: iomsg
 115
 116     iostat = 343
 117     stop 'fail'
 118   end subroutine
 119 end module m5
 120
 121 module m6
 122   interface read(formatted)
 123     procedure :: formattedReadProc
 124   end interface
 125
 126   contains
 127     subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 128     !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have a derived type
 129       integer, intent(inout) :: dtv
 130       integer, intent(in) :: unit
 131       character(len=*), intent(in) :: iotype ! error, must be deferred
 132       integer, intent(in) :: vlist(:)
 133       integer, intent(out) :: iostat
 134       character(len=*), intent(inout) :: iomsg
 135     end subroutine
 136 end module m6
 137
 138 module m7
 139   type,public :: t
 140     integer c
 141   contains
 142     procedure, pass :: tbp=>formattedReadProc
 143     generic :: read(formatted) => tbp
 144   end type
 145   private
 146 contains
 147   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 148     !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(INOUT)'
 149     class(t), intent(in) :: dtv ! Error, must be intent(inout)
 150     integer, intent(in) :: unit
 151     character(len=*), intent(in) :: iotype
 152     integer, intent(in) :: vlist(:)
 153     integer, intent(out) :: iostat
 154     character(len=*), intent(inout) :: iomsg
 155
 156     iostat = 343
 157     stop 'fail'
 158   end subroutine
 159 end module m7
 160
 161 module m8
 162   type,public :: t
 163     integer c
 164   contains
 165     procedure, pass :: tbp=>formattedWriteProc
 166     generic :: write(formatted) => tbp
 167   end type
 168   private
 169 contains
 170   subroutine formattedWriteProc(dtv, unit, iotype, vlist, iostat, iomsg)
 171     !ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(IN)'
 172     class(t), intent(inout) :: dtv ! Error, must be intent(inout)
 173     integer, intent(in) :: unit
 174     character(len=*), intent(in) :: iotype
 175     integer, intent(in) :: vlist(:)
 176     integer, intent(out) :: iostat
 177     character(len=*), intent(inout) :: iomsg
 178
 179     iostat = 343
 180     stop 'fail'
 181   end subroutine
 182 end module m8
 183
 184 module m9
 185   type,public :: t
 186     integer c
 187   contains
 188     procedure, pass :: tbp=>formattedReadProc
 189     generic :: read(formatted) => tbp
 190   end type
 191   private
 192 contains
 193   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 194     class(t), intent(inout) :: dtv ! Error, can't have attributes
 195     !ERROR: Dummy argument 'unit' of a defined input/output procedure may not have any attributes
 196     integer,  pointer, intent(in) :: unit
 197     character(len=*), intent(in) :: iotype
 198     integer, intent(in) :: vlist(:)
 199     integer, intent(out) :: iostat
 200     character(len=*), intent(inout) :: iomsg
 201
 202     iostat = 343
 203     stop 'fail'
 204   end subroutine
 205 end module m9
 206
 207 module m10
 208   type,public :: t
 209     integer c
 210   contains
 211     procedure, pass :: tbp=>formattedReadProc
 212     generic :: read(formatted) => tbp
 213   end type
 214   private
 215 contains
 216   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 217     class(t), intent(inout) :: dtv
 218     !ERROR: Dummy argument 'unit' of a defined input/output procedure must be an INTEGER of default KIND
 219     real, intent(in) :: unit ! Error, must be an integer
 220     character(len=*), intent(in) :: iotype
 221     integer, intent(in) :: vlist(:)
 222     integer, intent(out) :: iostat
 223     character(len=*), intent(inout) :: iomsg
 224
 225     iostat = 343
 226     stop 'fail'
 227   end subroutine
 228 end module m10
 229
 230 module m11
 231   type,public :: t
 232     integer c
 233   contains
 234     procedure, pass :: tbp=>formattedReadProc
 235     generic :: read(formatted) => tbp
 236   end type
 237   private
 238 contains
 239   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 240     class(t), intent(inout) :: dtv
 241     !ERROR: Dummy argument 'unit' of a defined input/output procedure must be an INTEGER of default KIND
 242     integer(8), intent(in) :: unit ! Error, must be default KIND
 243     character(len=*), intent(in) :: iotype
 244     integer, intent(in) :: vlist(:)
 245     integer, intent(out) :: iostat
 246     character(len=*), intent(inout) :: iomsg
 247
 248     iostat = 343
 249     stop 'fail'
 250   end subroutine
 251 end module m11
 252
 253 module m12
 254   type,public :: t
 255     integer c
 256   contains
 257     procedure, pass :: tbp=>formattedReadProc
 258     generic :: read(formatted) => tbp
 259   end type
 260   private
 261 contains
 262   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 263     class(t), intent(inout) :: dtv
 264     !ERROR: Dummy argument 'unit' of a defined input/output procedure must be a scalar
 265     integer, dimension(22), intent(in) :: unit ! Error, must be a scalar
 266     character(len=*), intent(in) :: iotype
 267     integer, intent(in) :: vlist(:)
 268     integer, intent(out) :: iostat
 269     character(len=*), intent(inout) :: iomsg
 270
 271     iostat = 343
 272     stop 'fail'
 273   end subroutine
 274 end module m12
 275
 276 module m13
 277   type,public :: t
 278     integer c
 279   contains
 280     procedure, pass :: tbp=>formattedReadProc
 281     generic :: read(formatted) => tbp
 282   end type
 283   private
 284 contains
 285   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 286     class(t), intent(inout) :: dtv
 287     !ERROR: Dummy argument 'unit' of a defined input/output procedure must have intent 'INTENT(IN)'
 288     integer, intent(out) :: unit !Error, must be intent(in)
 289     character(len=*), intent(in) :: iotype
 290     integer, intent(in) :: vlist(:)
 291     integer, intent(out) :: iostat
 292     character(len=*), intent(inout) :: iomsg
 293
 294     iostat = 343
 295     stop 'fail'
 296   end subroutine
 297 end module m13
 298
 299 module m14
 300   type,public :: t
 301     integer c
 302   contains
 303     procedure, pass :: tbp=>formattedReadProc
 304     generic :: read(formatted) => tbp
 305   end type
 306   private
 307 contains
 308   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 309     class(t), intent(inout) :: dtv
 310     !ERROR: Dummy argument 'unit' of a defined input/output procedure must have intent 'INTENT(IN)'
 311     integer :: unit !Error, must be INTENT(IN)
 312     character(len=*), intent(in) :: iotype
 313     integer, intent(in) :: vlist(:)
 314     integer, intent(out) :: iostat
 315     character(len=*), intent(inout) :: iomsg
 316
 317     iostat = 343
 318     stop 'fail'
 319   end subroutine
 320 end module m14
 321
 322 module m15
 323   type,public :: t
 324     integer c
 325   contains
 326     procedure, pass :: tbp=>formattedReadProc
 327     generic :: read(formatted) => tbp
 328   end type
 329   private
 330 contains
 331   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 332     class(t), intent(inout) :: dtv
 333     integer, intent(in) :: unit
 334     !ERROR: Dummy argument 'iotype' of a defined input/output procedure must be assumed-length CHARACTER
 335     character(len=5), intent(in) :: iotype ! Error, must be assumed length
 336     integer, intent(in) :: vlist(:)
 337     integer, intent(out) :: iostat
 338     character(len=*), intent(inout) :: iomsg
 339
 340     iostat = 343
 341     stop 'fail'
 342   end subroutine
 343 end module m15
 344
 345 module m16
 346   type,public :: t
 347     integer c
 348   contains
 349     procedure, pass :: tbp=>formattedReadProc
 350     generic :: read(formatted) => tbp
 351   end type
 352   private
 353 contains
 354   subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
 355     class(t), intent(inout) :: dtv
 356     integer, intent(in) :: unit
 357     character(len=*), intent(in) :: iotype
 358     !ERROR: Dummy argument 'vlist' of a defined input/output procedure must be deferred shape
 359     integer, intent(in) :: vlist(5)
 360     integer, intent(out) :: iostat
 361     character(len=*), intent(inout) :: iomsg
 362
 363     iostat = 343
 364     stop 'fail'
 365   end subroutine
 366 end module m16
 367
 368 module m17
 369   ! Test the same defined input/output procedure specified as a generic
 370   type t
 371     integer c
 372   contains
 373     procedure :: formattedReadProc
 374   end type
 375
 376   interface read(formatted)
 377     module procedure formattedReadProc
 378   end interface
 379
 380 contains
 381   subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
 382     class(t),intent(inout) :: dtv
 383     integer,intent(in) :: unit
 384     character(*),intent(in) :: iotype
 385     integer,intent(in) :: v_list(:)
 386     integer,intent(out) :: iostat
 387     character(*),intent(inout) :: iomsg
 388     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 389     print *,v_list
 390   end subroutine
 391 end module
 392
 393 module m18
 394   ! Test the same defined input/output procedure specified as a type-bound
 395   ! procedure and as a generic
 396   type t
 397     integer c
 398   contains
 399     procedure :: formattedReadProc
 400     generic :: read(formatted) => formattedReadProc
 401   end type
 402   interface read(formatted)
 403     module procedure formattedReadProc
 404   end interface
 405 contains
 406   subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
 407     class(t),intent(inout) :: dtv
 408     integer,intent(in) :: unit
 409     character(*),intent(in) :: iotype
 410     integer,intent(in) :: v_list(:)
 411     integer,intent(out) :: iostat
 412     character(*),intent(inout) :: iomsg
 413     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 414     print *,v_list
 415   end subroutine
 416 end module
 417
 418 module m19
 419   ! Test two different defined input/output procedures specified as a
 420   ! type-bound procedure and as a generic for the same derived type
 421   type t
 422     integer c
 423   contains
 424     procedure :: unformattedReadProc1
 425     generic :: read(unformatted) => unformattedReadProc1
 426   end type
 427   interface read(unformatted)
 428     module procedure unformattedReadProc
 429   end interface
 430 contains
 431   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 432     class(t),intent(inout) :: dtv
 433     integer,intent(in) :: unit
 434     integer,intent(out) :: iostat
 435     character(*),intent(inout) :: iomsg
 436     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 437   end subroutine
 438   !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)'
 439   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 440     class(t),intent(inout) :: dtv
 441     integer,intent(in) :: unit
 442     integer,intent(out) :: iostat
 443     character(*),intent(inout) :: iomsg
 444     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 445   end subroutine
 446 end module
 447
 448 module m20
 449   ! Test read and write defined input/output procedures specified as a
 450   ! type-bound procedure and as a generic for the same derived type
 451   type t
 452     integer c
 453   contains
 454     procedure :: unformattedReadProc
 455     generic :: read(unformatted) => unformattedReadProc
 456   end type
 457   interface read(unformatted)
 458     module procedure unformattedReadProc
 459   end interface
 460   interface write(unformatted)
 461     module procedure unformattedWriteProc
 462   end interface
 463 contains
 464   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 465     class(t),intent(inout) :: dtv
 466     integer,intent(in) :: unit
 467     integer,intent(out) :: iostat
 468     character(*),intent(inout) :: iomsg
 469     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 470   end subroutine
 471   subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
 472     class(t),intent(in) :: dtv
 473     integer,intent(in) :: unit
 474     integer,intent(out) :: iostat
 475     character(*),intent(inout) :: iomsg
 476     write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 477   end subroutine
 478 end module
 479
 480 module m21
 481   ! Test read and write defined input/output procedures specified as a
 482   ! type-bound procedure and as a generic for the same derived type with a
 483   ! KIND type parameter where they both have the same value
 484   type t(typeParam)
 485     integer, kind :: typeParam = 4
 486     integer c
 487   contains
 488     procedure :: unformattedReadProc
 489     generic :: read(unformatted) => unformattedReadProc
 490   end type
 491   interface read(unformatted)
 492     module procedure unformattedReadProc1
 493   end interface
 494 contains
 495   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 496     class(t),intent(inout) :: dtv
 497     integer,intent(in) :: unit
 498     integer,intent(out) :: iostat
 499     character(*),intent(inout) :: iomsg
 500     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 501   end subroutine
 502   !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)'
 503   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 504     class(t(4)),intent(inout) :: dtv
 505     integer,intent(in) :: unit
 506     integer,intent(out) :: iostat
 507     character(*),intent(inout) :: iomsg
 508     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 509   end subroutine
 510 end module
 511
 512 module m22
 513   ! Test read and write defined input/output procedures specified as a
 514   ! type-bound procedure and as a generic for the same derived type with a
 515   ! KIND type parameter where they have different values
 516   type t(typeParam)
 517     integer, kind :: typeParam = 4
 518     integer c
 519   contains
 520     procedure :: unformattedReadProc
 521     generic :: read(unformatted) => unformattedReadProc
 522   end type
 523   interface read(unformatted)
 524     module procedure unformattedReadProc1
 525   end interface
 526 contains
 527   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 528     class(t),intent(inout) :: dtv
 529     integer,intent(in) :: unit
 530     integer,intent(out) :: iostat
 531     character(*),intent(inout) :: iomsg
 532     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 533   end subroutine
 534   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 535     class(t(3)),intent(inout) :: dtv
 536     integer,intent(in) :: unit
 537     integer,intent(out) :: iostat
 538     character(*),intent(inout) :: iomsg
 539     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 540   end subroutine
 541 end module
 542
 543 module m23
 544   type t(typeParam)
 545   ! Test read and write defined input/output procedures specified as a
 546   ! type-bound procedure and as a generic for the same derived type with a
 547   ! LEN type parameter where they have different values
 548     integer, len :: typeParam = 4
 549     integer c
 550   contains
 551     procedure :: unformattedReadProc
 552     generic :: read(unformatted) => unformattedReadProc
 553   end type
 554   interface read(unformatted)
 555     module procedure unformattedReadProc1
 556   end interface
 557 contains
 558   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 559     class(t(*)),intent(inout) :: dtv
 560     integer,intent(in) :: unit
 561     integer,intent(out) :: iostat
 562     character(*),intent(inout) :: iomsg
 563     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 564   end subroutine
 565   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 566     class(t(3)),intent(inout) :: dtv
 567     integer,intent(in) :: unit
 568     integer,intent(out) :: iostat
 569     character(*),intent(inout) :: iomsg
 570     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 571   end subroutine
 572 end module
 573
 574 module m24
 575   ! Test read and write defined input/output procedures specified as a
 576   ! type-bound procedure and as a generic for the same derived type with a
 577   ! LEN type parameter where they have the same value
 578   type t(typeParam)
 579     integer, len :: typeParam = 4
 580     integer c
 581   contains
 582     procedure :: unformattedReadProc
 583     generic :: read(unformatted) => unformattedReadProc
 584   end type
 585   interface read(unformatted)
 586     module procedure unformattedReadProc1
 587   end interface
 588 contains
 589   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 590     class(t(*)),intent(inout) :: dtv
 591     integer,intent(in) :: unit
 592     integer,intent(out) :: iostat
 593     character(*),intent(inout) :: iomsg
 594     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 595   end subroutine
 596   !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)'
 597   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 598     class(t(*)),intent(inout) :: dtv
 599     integer,intent(in) :: unit
 600     integer,intent(out) :: iostat
 601     character(*),intent(inout) :: iomsg
 602     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 603   end subroutine
 604 end module
 605
 606 module m25a
 607   ! Test against false error when two defined I/O procedures exist
 608   ! for the same type but are not both visible in the same scope.
 609   type t
 610     integer c
 611   end type
 612   interface read(unformatted)
 613     module procedure unformattedReadProc1
 614   end interface
 615  contains
 616   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 617     class(t),intent(inout) :: dtv
 618     integer,intent(in) :: unit
 619     integer,intent(out) :: iostat
 620     character(*),intent(inout) :: iomsg
 621     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 622   end subroutine
 623 end module
 624 subroutine m25b
 625   use m25a, only: t
 626   interface read(unformatted)
 627     procedure unformattedReadProc2
 628   end interface
 629  contains
 630   subroutine unformattedReadProc2(dtv,unit,iostat,iomsg)
 631     class(t),intent(inout) :: dtv
 632     integer,intent(in) :: unit
 633     integer,intent(out) :: iostat
 634     character(*),intent(inout) :: iomsg
 635     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 636   end subroutine
 637 end subroutine