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     print *,v_list
 438   end subroutine
 439   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
 440   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 441     class(t),intent(inout) :: dtv
 442     integer,intent(in) :: unit
 443     integer,intent(out) :: iostat
 444     character(*),intent(inout) :: iomsg
 445     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 446     print *,v_list
 447   end subroutine
 448 end module
 449
 450 module m20
 451   ! Test read and write defined input/output procedures specified as a
 452   ! type-bound procedure and as a generic for the same derived type
 453   type t
 454     integer c
 455   contains
 456     procedure :: unformattedReadProc
 457     generic :: read(unformatted) => unformattedReadProc
 458   end type
 459   interface read(unformatted)
 460     module procedure unformattedReadProc
 461   end interface
 462   interface write(unformatted)
 463     module procedure unformattedWriteProc
 464   end interface
 465 contains
 466   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 467     class(t),intent(inout) :: dtv
 468     integer,intent(in) :: unit
 469     integer,intent(out) :: iostat
 470     character(*),intent(inout) :: iomsg
 471     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 472     print *,v_list
 473   end subroutine
 474   subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
 475     class(t),intent(in) :: dtv
 476     integer,intent(in) :: unit
 477     integer,intent(out) :: iostat
 478     character(*),intent(inout) :: iomsg
 479     write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 480     print *,v_list
 481   end subroutine
 482 end module
 483
 484 module m21
 485   ! Test read and write defined input/output procedures specified as a
 486   ! type-bound procedure and as a generic for the same derived type with a
 487   ! KIND type parameter where they both have the same value
 488   type t(typeParam)
 489     integer, kind :: typeParam = 4
 490     integer c
 491   contains
 492     procedure :: unformattedReadProc
 493     generic :: read(unformatted) => unformattedReadProc
 494   end type
 495   interface read(unformatted)
 496     module procedure unformattedReadProc1
 497   end interface
 498 contains
 499   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 500     class(t),intent(inout) :: dtv
 501     integer,intent(in) :: unit
 502     integer,intent(out) :: iostat
 503     character(*),intent(inout) :: iomsg
 504     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 505     print *,v_list
 506   end subroutine
 507   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
 508   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 509     class(t(4)),intent(inout) :: dtv
 510     integer,intent(in) :: unit
 511     integer,intent(out) :: iostat
 512     character(*),intent(inout) :: iomsg
 513     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 514     print *,v_list
 515   end subroutine
 516 end module
 517
 518 module m22
 519   ! Test read and write defined input/output procedures specified as a
 520   ! type-bound procedure and as a generic for the same derived type with a
 521   ! KIND type parameter where they have different values
 522   type t(typeParam)
 523     integer, kind :: typeParam = 4
 524     integer c
 525   contains
 526     procedure :: unformattedReadProc
 527     generic :: read(unformatted) => unformattedReadProc
 528   end type
 529   interface read(unformatted)
 530     module procedure unformattedReadProc1
 531   end interface
 532 contains
 533   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 534     class(t),intent(inout) :: dtv
 535     integer,intent(in) :: unit
 536     integer,intent(out) :: iostat
 537     character(*),intent(inout) :: iomsg
 538     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 539     print *,v_list
 540   end subroutine
 541   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 542     class(t(3)),intent(inout) :: dtv
 543     integer,intent(in) :: unit
 544     integer,intent(out) :: iostat
 545     character(*),intent(inout) :: iomsg
 546     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 547     print *,v_list
 548   end subroutine
 549 end module
 550
 551 module m23
 552   type t(typeParam)
 553   ! Test read and write defined input/output procedures specified as a
 554   ! type-bound procedure and as a generic for the same derived type with a
 555   ! LEN type parameter where they have different values
 556     integer, len :: typeParam = 4
 557     integer c
 558   contains
 559     procedure :: unformattedReadProc
 560     generic :: read(unformatted) => unformattedReadProc
 561   end type
 562   interface read(unformatted)
 563     module procedure unformattedReadProc1
 564   end interface
 565 contains
 566   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 567     class(t(*)),intent(inout) :: dtv
 568     integer,intent(in) :: unit
 569     integer,intent(out) :: iostat
 570     character(*),intent(inout) :: iomsg
 571     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 572     print *,v_list
 573   end subroutine
 574   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 575     class(t(3)),intent(inout) :: dtv
 576     integer,intent(in) :: unit
 577     integer,intent(out) :: iostat
 578     character(*),intent(inout) :: iomsg
 579     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 580     print *,v_list
 581   end subroutine
 582 end module
 583
 584 module m24
 585   ! Test read and write defined input/output procedures specified as a
 586   ! type-bound procedure and as a generic for the same derived type with a
 587   ! LEN type parameter where they have the same value
 588   type t(typeParam)
 589     integer, len :: typeParam = 4
 590     integer c
 591   contains
 592     procedure :: unformattedReadProc
 593     generic :: read(unformatted) => unformattedReadProc
 594   end type
 595   interface read(unformatted)
 596     module procedure unformattedReadProc1
 597   end interface
 598 contains
 599   subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
 600     class(t(*)),intent(inout) :: dtv
 601     integer,intent(in) :: unit
 602     integer,intent(out) :: iostat
 603     character(*),intent(inout) :: iomsg
 604     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 605     print *,v_list
 606   end subroutine
 607   !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
 608   subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
 609     class(t(*)),intent(inout) :: dtv
 610     integer,intent(in) :: unit
 611     integer,intent(out) :: iostat
 612     character(*),intent(inout) :: iomsg
 613     read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
 614     print *,v_list
 615   end subroutine
 616 end module