Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

UDDTIO issues

IanH
Honored Contributor II
581 Views

UDDTIO just seems to be one of those areas that I can never get a clear run at, which means that I tend to avoid it, and hence I am not so familiar with it.  Apologies if that leads to some noise in the following.

The compiler is complaining about private components when an object in a namelist group is being handled by defined input/output procedure.  Note in this case the type of the object just has default accessibility for components of PRIVATE - there aren't actually any private components.

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
    PRIVATE                   ! #A
  CONTAINS
    PROCEDURE :: write_formatted
    GENERIC :: WRITE(FORMATTED) => write_formatted
  END TYPE t
CONTAINS
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), 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
  END SUBROUTINE write_formatted
END MODULE uddtio

PROGRAM bad_namelist
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x
  NAMELIST /nml/ x
  
  WRITE (*, nml)
END PROGRAM bad_namelist
>ifort /check:all /warn:all /standard-semantics "2016-03-17 bad-namelist.f90"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-17 bad-namelist.f90(12): remark #7712: This variable has not been used.   [DTV]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------^
2016-03-17 bad-namelist.f90(12): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
------------------------------------------------^
2016-03-17 bad-namelist.f90(42): error #7299: This namelist group object in this context cannot have private components.
   
  NAMELIST /nml/ x
-----------------^
compilation aborted for 2016-03-17 bad-namelist.f90 (code 1)

When implementing defined input for a list-directed read from an internal file, attempts to read from the unit result in a crash (when running under debugger an exception related to heap corruption is reported).

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
    PRIVATE
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted
  END TYPE t
CONTAINS
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    
    CHARACTER :: ch
    
    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) ch
  END SUBROUTINE read_formatted
END MODULE uddtio

PROGRAM bad_listdirected_internal_read
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x
  
  CHARACTER(10) :: buffer
  
  buffer = 'x'
  READ (buffer, *) x
END PROGRAM bad_listdirected_internal_read
>ifort /check:all /warn:all /standard-semantics /traceback /debug /Od "2016-03-17 bad-listdirected_internal_read.f90" &&
 "2016-03-17 bad-listdirected_internal_read.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-17 bad-listdirected_internal_read.f90(11): remark #7712: This variable has not been used.   [DTV]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
----------------------------^
2016-03-17 bad-listdirected_internal_read.f90(11): remark #7712: This variable has not been used.   [IOTYPE]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
---------------------------------------^
2016-03-17 bad-listdirected_internal_read.f90(11): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------------------------^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-17 bad-listdirected_internal_read.exe"
-debug
"-pdb:2016-03-17 bad-listdirected_internal_read.pdb"
-subsystem:console
-incremental:no
"2016-03-17 bad-listdirected_internal_read.obj"

(Execution results in "xxx has stopped working... windows is checking for a solution to the problem.")

There is a requirement that, without an iostat in the parent statement, program execution should be terminated by a non-zero iostate, and if so, that the processor make available the iomsg error message(F2003 9.5.3.7.2p15 or so).  I don't think ifort is doing this reliably.

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
  CONTAINS
    PROCEDURE :: write_formatted
    GENERIC :: WRITE(FORMATTED) => write_formatted
  END TYPE t
CONTAINS
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), 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 = 1
    iomsg = 'Tell me what went wrong!'
  END SUBROUTINE write_formatted
END MODULE uddtio

PROGRAM no_error_message
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x
  
  PRINT *, x
  PRINT "('All done')"
END PROGRAM no_error_message

 

>ifort /check:all /warn:all /standard-semantics /traceback "2016-03-17 no_error_message.f90" && "2016-03-17 no_error_mes
sage.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-17 no_error_message.f90(10): remark #7712: This variable has not been used.   [DTV]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------^
2016-03-17 no_error_message.f90(10): remark #7712: This variable has not been used.   [UNIT]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
----------------------------------^
2016-03-17 no_error_message.f90(10): remark #7712: This variable has not been used.   [IOTYPE]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
----------------------------------------^
2016-03-17 no_error_message.f90(10): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
------------------------------------------------^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-17 no_error_message.exe"
-subsystem:console
-incremental:no
"2016-03-17 no_error_message.obj"
All done

 

0 Kudos
16 Replies
IanH
Honored Contributor II
581 Views

When implementing a namelist read, end of record processing seems to be strange (though there is the possibility that my understanding of UDDTIO is strange in this case).

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
    INTEGER :: comp
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted
  END TYPE t
CONTAINS
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    
    CHARACTER :: ch
    CHARACTER(LEN(iomsg)) :: local_iomsg
    
    IF (iotype == 'NAMELIST') THEN
      ! Look for the first non-blank.
      DO
        ! Try and get a character from the record.
        !
        ! If PAD is 'YES', then we never hit EOR - which appears to be 
        ! contrary to F2008 9.6.4.5.3p7.  When it is no we get a error
        ! "input statement requires too much data", which appears to be 
        ! contrary to F2008 9.6.5.3p6.
        READ (unit, "(A)", IOSTAT=iostat, IOMSG=local_iomsg, PAD='NO') ch
        IF (IS_IOSTAT_EOR(iostat)) THEN
          ! On EOR, F2008 9.11.4p1(4) says the position is after 
          ! the current record.  Child data transfer statements don't 
          ! get "positioned prior to data transfer" (9.6.4.1p2(5)), so 
          ! that suggests that we need to explicitly make the next record 
          ! the current record.  Or perhaps I am wrong - either way not
          ! relevant to the bug report.
          READ (unit, "(/)", IOSTAT=iostat, IOMSG=iomsg)
          IF (iostat /= 0) THEN
            RETURN
          END IF
          ! Keep trying on the next record.
          CYCLE
        ELSE IF (iostat /= 0) THEN
          ! Something went wrong.
          iomsg = local_iomsg
          RETURN
        END IF
        
        ! Here if iostat == 0.
        !
        ! Stop cycling if we got a non-blank.
        IF (ch /= '') EXIT
      END DO
      
      dtv%comp = IACHAR(ch)    ! Just for fun.
    ELSE
      iostat = 1
      iomsg = 'not supported'
    END IF
  END SUBROUTINE read_formatted
END MODULE uddtio

PROGRAM namelist_eor
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x
  NAMELIST /nml/ x
  CHARACTER(:), ALLOCATABLE :: buffer(:)
  
  buffer = [  &
      '&NML  X=  ', &
      'z        /' ]
  
  READ (buffer, nml)
  
  PRINT *, x%comp
  
END PROGRAM namelist_eor

 

>ifort /check:all /warn:all /standard-semantics /traceback "2016-03-17 namelist-eor.f90" && "2016-03-17 namelist-eor.exe
"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-17 namelist-eor.f90(11): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------------------------^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-17 namelist-eor.exe"
-subsystem:console
-incremental:no
"2016-03-17 namelist-eor.obj"
forrtl: severe (67): input statement requires too much data, unit -5, file Internal Formatted NML R
Image              PC                Routine            Line        Source
2016-03-17 nameli  000000013F57A0EB  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F58D9BC  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F585316  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F581790  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F57DB54  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F571CC0  MAIN__                     76  2016-03-17 namelist-eor.f90
2016-03-17 nameli  000000013F5FC77E  Unknown               Unknown  Unknown
2016-03-17 nameli  000000013F5E5E6F  Unknown               Unknown  Unknown
kernel32.dll       00000000779C59ED  Unknown               Unknown  Unknown
ntdll.dll          0000000077AFB371  Unknown               Unknown  Unknown

 

0 Kudos
Steven_L_Intel1
Employee
581 Views

Thanks - I'll work through these and let you know what I find. We've recently fixed some issues with UDDTIO, but your cases seem to involve others.

0 Kudos
IanH
Honored Contributor II
581 Views

Positioning with UDDTIO on an unformatted stream file does not appear to be correct when there are list items in an input statement prior to the item handled by the defined input procedure.

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
    INTEGER :: comp
  CONTAINS
    PROCEDURE :: read_unformatted
    GENERIC :: READ(UNFORMATTED) => read_unformatted
  END TYPE t
CONTAINS
  SUBROUTINE read_unformatted(dtv, unit, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) ::iomsg
    
    READ (unit, IOSTAT=iostat, IOMSG=iomsg) dtv%comp
  END SUBROUTINE read_unformatted
END MODULE uddtio


PROGRAM unformatted_stream
  USE uddtio
  IMPLICIT NONE
  
  TYPE(t) :: x
  INTEGER :: unit
  INTEGER :: i1, i2
  
  OPEN(  &
      NEWUNIT=unit,  &
      FILE='unformatted_stream.bin',  &
      STATUS='REPLACE',  &
      ACTION='READWRITE',  &
      FORM='UNFORMATTED',  &
      ACCESS='STREAM' )
  WRITE (unit) INT(Z'00112233'), INT(Z'00445566'), INT(Z'00778899')
  
  REWIND(unit)
  
  READ (unit) i1, x, i2
  
  ! Expect the same sequence as above, but items 2 and 3 do not match.
  PRINT "(*('Z''',Z8.8,'''',:,', '))", i1, x, i2
  
  CLOSE(unit)
END PROGRAM unformatted_stream

 

>ifort /check:all /warn:all /standard-semantics "2016-03-18 unformatted-stream.f90" && "2016-03-18 unformatted-stream.ex
e"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-18 unformatted-stream.exe"
-subsystem:console
"2016-03-18 unformatted-stream.obj"
Z'00112233', Z'00112233', Z'00445566'

 

0 Kudos
Steven_L_Intel1
Employee
581 Views

This reply will track the various issues reported in this thread:

#1A, Error 7299 - DPD200408444 - fixed for 17.0

#1B, read from internal file - DPD200408719 - fixed for 17.0

#1C, IOMSG - DPD200408726 . Interesting to note that ERR= processing does occur. - Fixed for 17.0

#2, End of record processing - DPD200408760 (see comment below)

#4, Unformatted stream - DPD200408836 - fixed for 17.0

#11, same as #1B

#14, Repeat count, DPD200375504 - fixed for 17.0.1

0 Kudos
IanH
Honored Contributor II
581 Views

Further debugging here shows that issue #2, where no end-of-record iostat is being returned to a child input statement, occurs for any form of iotype, not just namelist.
 

0 Kudos
Steven_L_Intel1
Employee
581 Views

For the issue in post #2, I think you'll never get an EOR condition because you get that only from a nonadvancing READ and child data transfer statements are not allowed to use ADVANCE. It's an interesting question, because the behavior of a child transfer statement is very much like nonadvancing - it doesn't position before and it doesn't position after. But it doesn't qualify as nonadvancing by the rules of the standard. When you use PAD='YES', then yeah, the record gets padded indefinitely. That's correct behavior and both PAD='YES' and PAD='NO' behaviors mirror what you'd get with an ordinary formatted READ.

So, he says, let's check for the particular error one gets reading past the end of the record. If I do that, then the read with format '/' gets an EOF error, and I think that's wrong. I recall having a discussion about this sort of thing with the developers before, but I filed a report about it separately.

This program raises some interesting questions as to exactly how you are supposed to do what it wants to do.

0 Kudos
IanH
Honored Contributor II
581 Views

I'm obviously still trying to find my way with this, so feel free to laugh hysterically at the following, but I think formatted child IO is more than "very much like" nonadvancing, it is nonadvancing (F2008 9.6.2.4 - "A formatted child input/output statement is a nonadvancing input/output statement")

(That statement, combined with the last unqualified dot-point of 9.3.3.3p2, probably has unintended consequences for use of defined input/output on direct access formatted files.)

9.6.4.5.3p6 and p7, that you quote from, then mean we get an end of record condition when we hit the end of record, regardless of PAD.  (PAD does change the definition status.)  Bad compiler runtime - go and sit in the corner until you can give me EOR.

(The description of what happens for formatted stream input and hitting end of file with an incomplete final record in 9.6.4.5.3p7 perhaps implies that the input list item becomes defined with blanks, but 9.11.3p1(3) contradicts that.)

(Another inconsistency in the standard, but this time related to unformatted output, is 9.6.4.5.2p2 "If the file is connected for sequential or direct access, exactly one record is read or written" - that only sensibly can apply to parent data transfer statements.)

0 Kudos
Steven_L_Intel1
Employee
581 Views

I won't laugh - I had not spotted the text in 9.6.2.4. It's another case of needing to have the entire standard in your head in order to understand it.

I think you're right on that one.

With PAD='YES' I don't think you can ever get to the EOR, but I need to study this some more. Note that PAD='NO' has been the default for a very long time.

I will look at this again in the morning - my head hurts enough as it is.

0 Kudos
Steven_L_Intel1
Employee
581 Views

Ok, I updated the issue. As you note, 9.6.4.5.3p7 says that you both pad the record and return an EOR condition. (This is a bit weird, in my view, but I don't see how else to interpret it.)

0 Kudos
IanH
Honored Contributor II
581 Views

An ADVANCE specifier in a child input statement is supposed to be ignored (F2008 9.6.2.4).  However, if such a specifier is provided in a child input statement operating on an internal file, a runtime access violation results.

(Perhaps this is a variation of 1B, reported in #5 as DPD200408719.)

MODULE uddtio
  IMPLICIT NONE
  TYPE :: t
    CHARACTER :: ch
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted
  END TYPE t
CONTAINS
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    
    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg, ADVANCE='NO') dtv%ch  ! boom.
!    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) dtv%ch   ! "works"
  END SUBROUTINE read_formatted
END MODULE uddtio


PROGRAM internal_advance_av
  USE uddtio
  IMPLICIT NONE
  
  TYPE(t) :: x
  CHARACTER(10) :: buffer
  
  buffer = 'x'
  READ (buffer, "(DT)") x
  PRINT "('""',A,'""')", x%ch
END PROGRAM internal_advance_av

 

>ifort /check:all /warn:all /standard-semantics /traceback "2016-03-30 internal-advance-av.f90" && "2016-03-30 internal-advance-av.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-30 internal-advance-av.f90(10): remark #7712: This variable has not been used.   [IOTYPE]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
---------------------------------------^
2016-03-30 internal-advance-av.f90(10): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------------------------^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-30 internal-advance-av.exe"
-subsystem:console
-incremental:no
"2016-03-30 internal-advance-av.obj"
forrtl: severe (157): Program Exception - access violation
Image              PC                Routine            Line        Source
2016-03-30 intern  000000013F036A8E  Unknown               Unknown  Unknown
2016-03-30 intern  000000013F0311BD  UDDTIO_mp_READ_FO          18  2016-03-30 internal-advance-av.f90
2016-03-30 intern  000000013F03F99F  Unknown               Unknown  Unknown
2016-03-30 intern  000000013F0313FC  MAIN__                     32  2016-03-30 internal-advance-av.f90
2016-03-30 intern  000000013F0A224E  Unknown               Unknown  Unknown
2016-03-30 intern  000000013F08BD33  Unknown               Unknown  Unknown
kernel32.dll       00000000779C59ED  Unknown               Unknown  Unknown
ntdll.dll          0000000077AFB371  Unknown               Unknown  Unknown

 

0 Kudos
Steven_L_Intel1
Employee
581 Views

Probably, but I'll pass this on anyway.

0 Kudos
IanH
Honored Contributor II
581 Views

For namelist defined input, the runtime obliterates any IOMSG value defined by the procedure implementing defined input.
 

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted
  END TYPE t
CONTAINS
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    
    iostat = 1
    iomsg = 'Mary had a little lamb'
  END SUBROUTINE read_formatted
END MODULE uddtio

PROGRAM cannot_teach_namelist_nursery_rhyme
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x
  NAMELIST /nml/ x
  
  CHARACTER(:), ALLOCATABLE :: buffer
  
  INTEGER :: iostat
  CHARACTER(100) :: iomsg
  
  buffer = '&NML X=xxx/'
  
  READ (buffer, nml, IOSTAT=iostat, IOMSG=iomsg)
  PRINT "('IOSTAT of ',I0,' and IOMSG of ""',A,'""')", iostat, TRIM(iomsg)
END PROGRAM cannot_teach_namelist_nursery_rhyme

 

>ifort /check:all /warn:all /standard-semantics /traceback "2016-03-30 namelist-error.f90" && "2016-03-30 namelist-error.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

2016-03-30 namelist-error.f90(10): remark #7712: This variable has not been used.   [DTV]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
----------------------------^
2016-03-30 namelist-error.f90(10): remark #7712: This variable has not been used.   [UNIT]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
---------------------------------^
2016-03-30 namelist-error.f90(10): remark #7712: This variable has not been used.   [IOTYPE]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
---------------------------------------^
2016-03-30 namelist-error.f90(10): remark #7712: This variable has not been used.   [V_LIST]
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
-----------------------------------------------^
Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-30 namelist-error.exe"
-subsystem:console
-incremental:no
"2016-03-30 namelist-error.obj"
IOSTAT of 1 and IOMSG of "not a FORTRAN specific error"

 

0 Kudos
IanH
Honored Contributor II
581 Views

If the DT edit descriptor in a format specification is preceded with a repeat count greater than one, then the second invocation of the defined input/output procedure does not receive the correct values for the iotype and v_list arguments. 

(If the repeat count is greater than two, then I see evidence that the defined output procedure is not called at all for the third and subsequent items.)

MODULE uddtio
  IMPLICIT NONE
  
  TYPE :: t
    CHARACTER(:), ALLOCATABLE :: comp
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted
  END TYPE t
CONTAINS
  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    
    CHARACTER(5) :: str
    
    ! Read five characters
    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) str
    IF (iostat /= 0) RETURN
    
    ! Save the v_list and iotype
    ALLOCATE(CHARACTER(3) :: dtv%comp)
    WRITE (dtv%comp, "(I0)") SIZE(v_list)
    dtv%comp = dtv%comp // '-' // iotype
  END SUBROUTINE read_formatted
END MODULE uddtio

PROGRAM bad_repeat_iotype
  USE uddtio
  IMPLICIT NONE
  TYPE(t) :: x1, x2, x3
  CHARACTER(15) :: buffer
  
  buffer = '12345abcde12345'
  READ (buffer, "(3DT'hello'(1,2))") x1, x2, x3
  
  PRINT "(A)", x1%comp
  PRINT "(A)", x2%comp
  PRINT "(A)", x3%comp   ! Crashes.
END PROGRAM bad_repeat_iotype

 

>ifort /check:all /warn:all /standard-semantics /traceback "2016-03-30 bad-repeat-iotype.f90" && "2016-03-30 bad-repeat-iotype.exe"
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 16.0 Build 20160204
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 10.00.40219.01
Copyright (C) Microsoft Corporation.  All rights reserved.

"-out:2016-03-30 bad-repeat-iotype.exe"
-subsystem:console
-incremental:no
"2016-03-30 bad-repeat-iotype.obj"
2  -DThello
0  -DT
forrtl: severe (408): fort: (7): Attempt to use pointer COMP when it is not associated with a target

Image              PC                Routine            Line        Source
2016-03-30 bad-re  000000013F4EAFFE  Unknown               Unknown  Unknown
2016-03-30 bad-re  000000013F4E1FBA  MAIN__                     43  2016-03-30 bad-repeat-iotype.f90
2016-03-30 bad-re  000000013F55B8CE  Unknown               Unknown  Unknown
2016-03-30 bad-re  000000013F5453A7  Unknown               Unknown  Unknown
kernel32.dll       00000000779C59ED  Unknown               Unknown  Unknown
ntdll.dll          0000000077AFB371  Unknown               Unknown  Unknown

 

0 Kudos
Steven_L_Intel1
Employee
581 Views

I believe that #14 is previously reported issue DPD200375504 from https://software.intel.com/en-us/forums/topic/590310

0 Kudos
Steven_L_Intel1
Employee
581 Views

1B (heap corruption) and 1C (IOMSG) have been fixed, probably for the 17.0 product release. For the IOMSG issue, we thought again about all the various combinations of child routine behaviors and believe we now have correct responses to each of them.

0 Kudos
Steven_L_Intel1
Employee
581 Views

All of the issues raised in this thread have now been fixed. The last, from post #14, should get fixed in update 1 to 17.0.

0 Kudos
Reply