flang/test/Semantics/io11.f90

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