LI76089: INCORRECT TRACE/BPT TRAP CAUSING APP TO CORE

April 2011 Update for XL Fortran for Linux, V13.1
July 2011 Update for XL Fortran for Linux, V13.1
October 2011 Update for XL Fortran for Linux, V13.1
June 2012 Update for XL Fortran for Linux, V13.1
October 2012 Update for XL Fortran for Linux, V13.1
XL Fortran for Linux Fix Pack 8 (June 2013 Update) for 13.1

APAR status

• Closed as program error.

Error description

• The following test case cores at runtime when compiling with the
  following st of options:
  
  ===Compile command:
  
  xlf95_r -g -qcheck -q64 -O3 -qstrict -qhot -c *.f90
  xlf95_r -g -qcheck -q64 -O3 -qstrict -qhot module_a.o
  module_b.o mini.o -o mini
  
  ===Test case:
  $ cat module_a.f90
  MODULE module_a
  
    IMPLICIT NONE
    PRIVATE
    SAVE
  
    INTEGER, PARAMETER, PUBLIC :: dp = SELECTED_REAL_KIND(12,307)
  
    PUBLIC :: strcrack
  
  CONTAINS
  
  !----------------------------------------------------------
    SUBROUTINE strcrack(str, ch, el, n)
  
      ! strcrack = string crack
  
      ! Split the string <str> into small pieces which are
  separated by
      ! the character <ch>. Delete trailing spaces from the
  resulting <n>
      ! pieces, then put them into the array <el>.
  
      IMPLICIT NONE
      INTRINSIC :: ADJUSTL, ASSOCIATED, INDEX, LEN_TRIM, TRIM, LEN
  
      ! I/O
      CHARACTER(LEN=*),               INTENT(IN)  :: str ! string
  2b cracked
      CHARACTER,                      INTENT(IN)  :: ch  !
  separating char
      CHARACTER(LEN=*), DIMENSION(:), POINTER     :: el  ! field
  of substrings
      INTEGER,                        INTENT(OUT) :: n   ! # of
  substrings
  
      INTEGER :: idx1, idx2, i, status
  
      IF (ASSOCIATED(el)) DEALLOCATE(el)
      NULLIFY(el)
      n = 0
  
      ! EMPTY STRING
      IF ( (TRIM(str) == '') .OR. (TRIM(str) == ch) ) RETURN
  
      idx1 = 0
      idx2 = 0
      DO
         idx1 = idx2 + 1
         IF (idx1 > LEN_TRIM(str(:))) EXIT
         IF (INDEX(TRIM(str(idx1:)), ch) == 0) THEN
            idx2 = LEN_TRIM(str(:)) + 1
         ELSE
            idx2 = idx2 + INDEX(TRIM(str(idx1:)), ch)
         END IF
         IF (idx1 == idx2) CYCLE
  
         n = n + 1
  
      END DO
  
      ! ALLOCATE SPACE
      WRITE(*,*) 'QMA1 ',n, LEN(str), LEN_TRIM(str), TRIM(str)
      ALLOCATE(el(n), STAT=status)
      WRITE(*,*) 'QMA2 ',n, LEN(str), LEN_TRIM(str), TRIM(str),
  status
      DO i=1, n
         el(i) = ' '
      END DO
  
      n = 0
      idx1 = 0
      idx2 = 0
      DO
         idx1 = idx2 + 1
         IF (idx1 > LEN_TRIM(str(:))) EXIT
         IF (INDEX(TRIM(str(idx1:)), ch) == 0) THEN
            idx2 = LEN_TRIM(str(:)) + 1
         ELSE
            idx2 = idx2 + INDEX(TRIM(str(idx1:)), ch)
         END IF
         IF (idx1 == idx2) CYCLE
  
         n = n + 1
  
         el(n) = ADJUSTL(str(idx1:idx2-1))
  
      END DO
  
    END SUBROUTINE strcrack
  !---------------------------------------------------
  
  END MODULE module_a
  $
  $
  $ cat module_b.f90
  MODULE module_b
  
    USE module_a, ONLY: dp
  
    IMPLICIT NONE
    PRIVATE
    SAVE
  
    PUBLIC :: parse_str
  
  CONTAINS
  
  
  !----------------------------------
  
    SUBROUTINE parse_str(status, strlen, str, nml, var, file, z,
  heights, ixf)
  
      USE module_a, ONLY: strcrack
  
      IMPLICIT NONE
  
      INTRINSIC :: TRIM, ADJUSTL
  
      ! I/O
      INTEGER,          INTENT(OUT)   :: status   ! status
  information
      INTEGER,          INTENT(IN)    :: strlen   ! max. length of
  strings
      CHARACTER(LEN=*), INTENT(IN)    :: str      ! string to
  parse
      CHARACTER(LEN=*), INTENT(INOUT) :: nml      ! namelist file
      CHARACTER(LEN=*), INTENT(INOUT) :: var      ! netCDF
  variable
      CHARACTER(LEN=*), INTENT(INOUT) :: file     ! netCDF file
      REAL(DP), DIMENSION(:), POINTER :: z        ! level
  information
      CHARACTER(LEN=*), INTENT(INOUT) :: heights  ! string
  containing heights
      INTEGER,          INTENT(INOUT) :: ixf      ! index
  regridding
  
      CHARACTER(LEN=strlen),               POINTER     :: sl1(:)
      CHARACTER(LEN=strlen),               POINTER     :: sl2(:)
      CHARACTER(LEN=strlen),               POINTER     :: sl3(:)
      INTEGER :: n, m, l
      INTEGER :: i, j
      INTEGER :: iostat
  
      status = 1 ! ERROR
  
      NULLIFY(sl1)
      NULLIFY(sl2)
      NULLIFY(sl3)
  
      IF (ASSOCIATED(z)) THEN
         DEALLOCATE(z)
         NULLIFY(z)
      END IF
  
      CALL strcrack(str, ';', sl1, n)
      DO i=1, n
         WRITE(*,*) 'QMB1 ',i,TRIM(sl1(i))
         CALL strcrack(sl1(i), '=', sl2, m)
         WRITE(*,*) 'QMB2 ',SIZE(sl2), m
         IF (SIZE(sl2) == 2) THEN
            IF (TRIM(ADJUSTL(sl2(2))) == '') THEN
               status = 2    ! EMPTY SPECIFICATION
               RETURN
            END IF
         END IF
         WRITE(*,*) 'QMB3 |',TRIM(sl2(1)),'|',TRIM(sl2(2)),'|'
         SELECT CASE(TRIM(ADJUSTL(sl2(1))))
            CASE('NML')
               nml = TRIM(ADJUSTL(sl2(2)))
            CASE('VAR')
               var = TRIM(ADJUSTL(sl2(2)))
            CASE('FILE')
               file = TRIM(ADJUSTL(sl2(2)))
            CASE('Z')
               heights=TRIM(ADJUSTL(sl2(2)))
               CALL strcrack(TRIM(ADJUSTL(sl2(2))), ',', sl3, l)
               ALLOCATE(z(l))
               DO j=1, l
                  READ(sl3(j),*,IOSTAT=iostat) z(j)
                  IF (iostat /= 0) THEN
                     status = 6  ! ERROR IN READING REAL
                     RETURN
                  END IF
               END DO
            CASE('IXF')
               READ(sl2(2),*,IOSTAT=iostat) ixf
                  IF (iostat /= 0) THEN
                     status = 7  ! ERROR IN READING INTEGER
                     RETURN
                  END IF
            CASE DEFAULT
               status = 3 ! UNKNOWN SPECIFIER
               RETURN
         END SELECT
  
      END DO
  
      ! CLEAN UP
      IF (ASSOCIATED(sl1)) DEALLOCATE(sl1)
      IF (ASSOCIATED(sl2)) DEALLOCATE(sl2)
  
      status = 0 ! NO ERROR
  
    END SUBROUTINE parse_str
  !--------------------------------------------------------------
  
  END MODULE module_b
  $
  

Local fix

• To avoid the issue, use:
  * -g -qcheck -q64 -O3 -qstrict -qhot -qminimaltoc -qsmallstack
  * -g -qcheck -qminimaltoc -qstacktemp=1 -q64 -O3 -qstrict -qhot
  * -g -qcheck -q64 -O3 -qstrict -qhot -qipa=level=0
  

Problem summary

• USERS AFFECTED:
  Users having automatic CHARACTER objects with runtime length in
  their code may encounter this problem.
  
  ROBLEM DESCRIPTION:
  User applications may produce incorrect result or abnormally
  terminate due to SEGFAULT.
  

Problem conclusion

• The problem has been fixed in the compiler.
  

Temporary fix

Comments

APAR Information

• APAR is sysrouted FROM one or more of the following:

  IZ91458

• APAR is sysrouted TO one or more of the following:

Fix information

• Fixed component name

  XL FORTRAN LINU

• Fixed component ID

  5724X1600

Applicable component levels

• RD10 PSN IZ91458

     UP06/09/13