Internal compiler error (fortran) and assignment operator?

I’m getting the following error/warning with pgfortran on the attached code:

PGF90-W-0000-Internal compiler error. sym_is_refd:bad sty 405 (internal_error.f90: 308)
0 inform, 1 warnings, 0 severes, 0 fatal for hf2002

The error is a bit weird, since the referenced line in the error message is just a standard assignment of a real value. I have added several !DEBUG statements throughout the code. The ICE goes away if I comment out the first line after any of those statements. This issue might be related to my previous post, but I add it as new topic since the compiler warning is different.

I’m running on openSUSE Tumbleweed with

pgfortran --version

pgfortran 16.10-0 64-bit target on x86-64 Linux -tp haswell


MODULE HS2Kinds
  USE ISO_FORTRAN_ENV, ONLY: INT8, INT16, INT32, INT64
  USE ISO_FORTRAN_ENV, ONLY: REAL32, REAL64
  IMPLICIT NONE
  PUBLIC

  INTEGER, PARAMETER :: I1B = INT8  !SELECTED_INT_KIND(2)
  INTEGER, PARAMETER :: I2B = INT16 !SELECTED_INT_KIND(4)
  INTEGER, PARAMETER :: I4B = INT32 !SELECTED_INT_KIND(9)
  INTEGER, PARAMETER :: L1B = KIND(.TRUE.) !LOGICAL_KINDS(1)

  INTEGER, PARAMETER :: LP = REAL32
  INTEGER, PARAMETER :: HP = REAL64
  INTEGER, PARAMETER :: WP = HP

  INTEGER(I1B), PARAMETER :: MAXI1B = HUGE(1_I1B)
  INTEGER(I2B), PARAMETER :: MAXI2B = HUGE(1_I2B)
  INTEGER(I4B), PARAMETER :: MAXI4B = HUGE(1_I4B)
END MODULE HS2Kinds


!------------------------------------------------------------------------------
!                                                                             !
!                               HS2Variant                                    !
!                                                                             !
!------------------------------------------------------------------------------
MODULE HS2Variant
  USE HS2Kinds
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: HSVariant


  TYPE HSVariant
     INTEGER(I4B) :: id =  MAXI4B
  END TYPE HSVariant

END MODULE HS2Variant



!------------------------------------------------------------------------------
!                                                                             !
!                               HS2List                                       !
!                                                                             !
!------------------------------------------------------------------------------
MODULE HS2List
  USE HS2Kinds
  USE HS2Variant, ONLY: HSVariant
  IMPLICIT NONE
  PRIVATE

  PUBLIC :: HSList

  TYPE :: HSLink
     CLASS(HSVariant), PRIVATE, POINTER :: v => NULL()
     CLASS(HSLink), PRIVATE, POINTER    :: next => NULL()
   CONTAINS
     ! DEBUG: Comment out next line and ICE disappears.
     FINAL:: finalizeLink
  END TYPE HSLink


  TYPE :: HSList
     CLASS(HSLink), PRIVATE, POINTER :: firstLink => NULL()
     CLASS(HSLink), PRIVATE, POINTER :: lastLink => NULL()

     CLASS(HSLink), PRIVATE, POINTER :: currentLink => NULL()
     INTEGER(I4B), PRIVATE :: LEN = 0
   CONTAINS
     PROCEDURE, PASS :: appendList
     PROCEDURE, PASS :: clear
  END TYPE HSList

CONTAINS

  RECURSIVE SUBROUTINE finalizeLink(this)
    TYPE(HSLink), INTENT(INOUT) :: this

    CHARACTER(LEN=32) :: err
    INTEGER(I4B) :: i

    IF (ASSOCIATED(this%v)) THEN
       DEALLOCATE(this%v)
       this%v => NULL()
    END IF
    IF (ASSOCIATED(this%next)) THEN
       DEALLOCATE(this%next, STAT=i)
       IF (i /= 0) THEN
          WRITE(err,*) i
          WRITE(*,"(A)") "HSLink::finalizeLink():: Failed to deallocate " //  &
               & "link with STAT = " // TRIM(err)
          STOP 134
       END IF
    END IF
  END SUBROUTINE finalizeLink


  SUBROUTINE appendList(this, list)
    CLASS(HSList), INTENT(INOUT) :: this
    CLASS(HSList), INTENT(IN)    :: list

    ! Does nothing
    RETURN
  END SUBROUTINE appendList


  SUBROUTINE clear(this)
    CLASS(HSList), INTENT(INOUT) :: this

    this%LEN = 0
    IF (.NOT.ASSOCIATED(this%firstLink)) RETURN
    this%lastLink => NULL()

    DEALLOCATE(this%firstLink)
    this%firstLink => NULL()
    RETURN
  END SUBROUTINE clear

END MODULE HS2List




!------------------------------------------------------------------------------
!                                                                             !
!                               HS2String                                     !
!                                                                             !
!------------------------------------------------------------------------------
MODULE HS2String
  USE HS2Kinds
  USE HS2Variant, ONLY: HSVariant
  USE HS2List, ONLY: HSList
  IMPLICIT NONE
  PRIVATE
  SAVE

  PUBLIC :: HSString

  TYPE, EXTENDS(HSVariant) :: HSString
     CHARACTER(LEN=:), PRIVATE, ALLOCATABLE :: str
     INTEGER(I4B), PRIVATE :: LEN = 0
   CONTAINS
     ! DEBUG: Comment out next line and ICE disappears
     PROCEDURE, PASS :: splitHSString

     GENERIC :: ASSIGNMENT(=) => setAscii!
     PROCEDURE, PASS :: setAscii
  END TYPE HSString


  TYPE, EXTENDS(HSList) :: HSStringList
   CONTAINS
     GENERIC :: ASSIGNMENT(=) => setHSList
     PROCEDURE, PASS :: setHSList
  END TYPE HSStringList


CONTAINS
  ELEMENTAL SUBROUTINE setAscii(this, str)
    CLASS(HSString), INTENT(INOUT)          :: this
    CHARACTER(LEN=*), INTENT(IN) :: str

    INTEGER(I4B) :: l


    l = LEN(str)
    this%LEN = l
    IF (ALLOCATED(this%str)) DEALLOCATE(this%str)
    IF (this%LEN == 0) RETURN

    ALLOCATE(CHARACTER(LEN=l)::this%str)
    this%str(1:this%LEN) = str(1:this%LEN)
    RETURN
  END SUBROUTINE setAscii


  FUNCTION splitHSString(this, sep, keepEmpty,caseSensitive) RESULT(answ)
    CLASS(HSString), INTENT(IN)        :: this
    TYPE(HSString), INTENT(IN)         :: sep
    LOGICAL(L1B), OPTIONAL, INTENT(IN) :: keepEmpty, caseSensitive
    TYPE(HSStringList)                 :: answ


    CALL answ%clear()
  END FUNCTION splitHSString

  SUBROUTINE setHSList(this, from)
    CLASS(HSStringList), INTENT(INOUT) :: this
    TYPE(HSStringList), INTENT(IN)     :: from

    CALL this%clear()
    CALL this%HSlist%appendList(from)
    RETURN
  END SUBROUTINE setHSList

END MODULE HS2String


!------------------------------------------------------------------------------
!                                                                             !
!                               HS2DateTime                                   !
!                                                                             !
!------------------------------------------------------------------------------
MODULE HS2DateTime
  USE HS2Kinds
  USE HS2String, ONLY: HSString
  IMPLICIT NONE
  PRIVATE
  SAVE


  TYPE HSTimeSpec
     INTEGER(I1B), PRIVATE :: val = 2
   CONTAINS
     ! DEBUG: Comment out next line and ICE disappears
     PROCEDURE, PASS :: specToString

     GENERIC :: ASSIGNMENT(=) => setTimeSpecTS
     GENERIC :: OPERATOR(==)  => timeSpecsAreEqual

     PROCEDURE, PRIVATE, PASS :: setTimeSpecTS
     PROCEDURE, PRIVATE, PASS :: timeSpecsAreEqual
  END TYPE HSTimeSpec

  TYPE(HSTimeSpec), PARAMETER :: HSUTC = HSTimeSpec(0)
  TYPE(HSTimeSpec), PARAMETER :: HSTAI = HSTimeSpec(1)
  TYPE(HSTimeSpec), PARAMETER :: HSGPS = HSTimeSpec(2)
  TYPE(HSTimeSpec), PARAMETER :: HSTT  = HSTimeSpec(3)
  TYPE(HSTimeSpec), PARAMETER :: HSTCG = HSTimeSpec(4)
  TYPE(HSTimeSpec), PARAMETER :: HSTCB = HSTimeSpec(5)
  TYPE(HSTimeSpec), PARAMETER :: HSTDB = HSTimeSpec(6)


  TYPE HSJulianDay
     INTEGER(I4B)     :: JDN = 2451545
     REAL(HP)         :: FD = 0.0_HP
     TYPE(HSTimeSpec) :: spec = HSUTC
   CONTAINS
     PROCEDURE, PASS :: setJulianDay
     GENERIC :: ASSIGNMENT(=) => setJulianDay
  END TYPE HSJulianDay


CONTAINS

  FUNCTION specToString(this) RESULT(answ)
    CLASS(HSTimeSpec), INTENT(IN) :: this
    TYPE(HSString)                :: answ

    answ = "Unknown timescale"
  END FUNCTION specToString

  ELEMENTAL SUBROUTINE setTimeSpecTS(this, from)
    CLASS(HSTimeSpec), INTENT(INOUT) :: this
    TYPE(HSTimeSpec), INTENT(IN)     :: from

    this%val = from%val
    RETURN
  END SUBROUTINE setTimeSpecTS

  ELEMENTAL FUNCTION timeSpecsAreEqual(a, b) RESULT(answ)
    CLASS(HSTimeSpec), INTENT(IN) :: a
    TYPE(HSTimeSpec), INTENT(IN)  :: b
    LOGICAL(L1B)                  :: answ

    answ = (a%val == b%val)
    RETURN
  END FUNCTION timeSpecsAreEqual


  ELEMENTAL SUBROUTINE setJulianDay(this, from)
    CLASS(HSJulianDay), INTENT(INOUT) :: this
    CLASS(HSJulianDay), INTENT(IN)    :: from

    this%JDN  = from%JDN
    this%FD   = from%FD
    this%spec = from%spec
    IF (this%FD < 0.0_HP) THEN
       DO
          IF (this%FD >= 0.0_HP) EXIT

          this%JDN = this%JDN - 1
          this%FD = this%FD + 1.0_HP
       END DO
    END IF
    IF (this%FD >= 1.0_HP) THEN
       DO
          IF (this%FD < 1.0_HP) EXIT

          this%JDN = this%JDN + 1
          this%FD = this%FD - 1.0_HP
       END DO
    END IF
    RETURN
  END SUBROUTINE setJulianDay


  ELEMENTAL FUNCTION HF2002(tdb) RESULT (answ)
    CLASS(HSJulianDay), INTENT(IN) :: tdb
    REAL(WP)                       :: answ

    ! DEBUG: No ICE if I comment out the next line
    TYPE(HSJulianDay), PARAMETER :: TSTART = HSJulianDay(2305450,0.5_HP,HSTT)

    ! DEBUG: Internal compiler error here??? No ICE if I comment out the
    ! next line.
    answ = 1.0_WP

    RETURN
  END FUNCTION HF2002

END MODULE HS2DateTime



PROGRAM test_hsdatetime
  USE HS2DateTime

  WRITE(*,*) "compiled successfully"
END PROGRAM test_hsdatetime

Oystein,

We have replicated your behavior and we have assigned it
TPR 23568. I will try to find
out if the Warning affected the program execution. Never reassuring to
see warnings in compilations that are other than ‘implied casting’.

thanks,
dave