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 4module 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 13contains 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 25end module m1 26 27module 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 36contains 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 47end module m2 48 49module 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 58contains 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 70end module m3 71 72module 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 80contains 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(real), 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 95end module m4 96 97module 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 106contains 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 119end module m5 120 121module 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 136end module m6 137 138module 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 146contains 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 159end module m7 160 161module 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 169contains 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 182end module m8 183 184module 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 192contains 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 205end module m9 206 207module 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 215contains 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 228end module m10 229 230module 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 238contains 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 251end module m11 252 253module 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 261contains 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 274end module m12 275 276module 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 284contains 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 297end module m13 298 299module 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 307contains 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 320end module m14 321 322module 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 330contains 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 of default kind 335 character(len=5), intent(in) :: iotype ! Error, must be assumed length 336 integer, intent(in) :: vlist(:) 337 integer, intent(out) :: iostat 338 !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be assumed-length CHARACTER of default kind 339 character(len=5), intent(inout) :: iomsg 340 iostat = 343 341 stop 'fail' 342 end subroutine 343end module m15 344 345module 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 353contains 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 366end module m16 367 368module 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 380contains 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 391end module 392 393module 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 405contains 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 416end module 417 418module 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 430contains 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' has conflicting type-bound 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 446end module 447 448module 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 463contains 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 478end module 479 480module 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 494contains 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' has conflicting type-bound 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 510end module 511 512module 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 526contains 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 541end module 542 543module 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 ! KIND type parameter where they have different values 548 integer, kind :: 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 557contains 558 subroutine unformattedReadProc(dtv,unit,iostat,iomsg) 559 class(t(2)),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 572end module 573 574module m23a 575 type t(typeParam) 576 ! Test read and write defined input/output procedures specified as a 577 ! type-bound procedure and as a generic for the same derived type with a 578 ! KIND type parameter where they have the same value 579 integer, kind :: 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 588contains 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' has conflicting type-bound input/output procedure 'read(unformatted)' 597 subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) 598 class(t(4)),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 604end module 605 606module m24 607 ! Test read and write defined input/output procedures specified as a 608 ! type-bound procedure and as a generic for the same derived type with a 609 ! LEN type parameter where they are both assumed 610 type t(typeParam) 611 integer, len :: typeParam = 4 612 integer c 613 contains 614 procedure :: unformattedReadProc 615 generic :: read(unformatted) => unformattedReadProc 616 end type 617 interface read(unformatted) 618 module procedure unformattedReadProc1 619 end interface 620contains 621 subroutine unformattedReadProc(dtv,unit,iostat,iomsg) 622 class(t(*)),intent(inout) :: dtv 623 integer,intent(in) :: unit 624 integer,intent(out) :: iostat 625 character(*),intent(inout) :: iomsg 626 read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c 627 end subroutine 628 !ERROR: Derived type 't' has conflicting type-bound input/output procedure 'read(unformatted)' 629 subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) 630 class(t(*)),intent(inout) :: dtv 631 integer,intent(in) :: unit 632 integer,intent(out) :: iostat 633 character(*),intent(inout) :: iomsg 634 read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c 635 end subroutine 636end module 637 638module m25a 639 ! Test against false error when two defined I/O procedures exist 640 ! for the same type but are not both visible in the same scope. 641 type t 642 integer c 643 end type 644 interface read(unformatted) 645 module procedure unformattedReadProc1 646 end interface 647 contains 648 subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) 649 class(t),intent(inout) :: dtv 650 integer,intent(in) :: unit 651 integer,intent(out) :: iostat 652 character(*),intent(inout) :: iomsg 653 read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c 654 end subroutine 655end module 656subroutine m25b 657 use m25a, only: t 658 interface read(unformatted) 659 procedure unformattedReadProc2 660 end interface 661 contains 662 subroutine unformattedReadProc2(dtv,unit,iostat,iomsg) 663 class(t),intent(inout) :: dtv 664 integer,intent(in) :: unit 665 integer,intent(out) :: iostat 666 character(*),intent(inout) :: iomsg 667 read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c 668 end subroutine 669end subroutine 670 671module m26a 672 type t 673 integer n 674 end type 675 contains 676 subroutine unformattedRead(dtv,unit,iostat,iomsg) 677 class(t),intent(inout) :: dtv 678 integer,intent(in) :: unit 679 integer,intent(out) :: iostat 680 !ERROR: Dummy argument 'iomsg' of a defined input/output procedure must be assumed-length CHARACTER of default kind 681 character(kind=4,len=*),intent(inout) :: iomsg 682 !ERROR: Must have default kind(1) of CHARACTER type, but is CHARACTER(KIND=4,LEN=*) 683 read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%n 684 end subroutine 685end 686module m26b 687 use m26a 688 interface read(unformatted) 689 procedure unformattedRead 690 end interface 691end 692