| Issue |
141124
|
| Summary |
[flang][DTIO] The `iomsg=` specifier is corrupted when no actual I/O error occurred.
|
| Labels |
flang:runtime
|
| Assignees |
|
| Reporter |
DanielCChen
|
Consider the following code:
```
module m
type base
character(3) :: c = 'xxx'
contains
procedure, pass :: write => writeb
generic, private :: write(formatted) => write
end type
interface
subroutine writeb (dtv, unit, iotype, v_list, iostat, iomsg)
import base
class(base), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
end subroutine
end interface
contains
subroutine mywrite( dtv, stat, msg )
class(base), intent(in) :: dtv
integer, intent(out) :: stat
character(*), intent(inout) :: msg
print*, "in mywrite: msg=", msg
write ( 1, *, iostat = stat, iomsg = msg ) dtv
end subroutine
end module
program resolve005
use m
class(base), allocatable :: b1
integer :: stat = 0
character(8) :: msg = "original"
allocate ( b1, source = base('abc') )
open ( 1, file = 'resolve005.1', form='formatted', access='sequential' )
call mywrite ( b1, stat, msg)
if ( ( stat /= 0 ) .or. ( msg /= 'original' ) ) error stop 1
close ( 1, status ='delete')
end program
subroutine writeb (dtv, unit, iotype, v_list, iostat, iomsg)
use m, only: base
class(base), intent(in) :: dtv
integer, intent(in) :: unit
character(*), intent(in) :: iotype
integer, intent(in) :: v_list(:)
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
iostat = 0
print*, "in writeb, iomsg=", iomsg
end subroutine
```
The expected output should be
```
in mywrite: msg=original
in writeb, iomsg=original
```
Flang failed to generated the 2nd print. It seems the value of the actual argument `msg` is corrupted when there is not an actual I/O error.
The standard says in that case, the `iomsg=` specifier should be intact.
![]()
_______________________________________________
llvm-bugs mailing list
llvm-bugs@lists.llvm.org
https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-bugs
