Conference turris::fortran

1274.0. "DF90AO: Varying strings "compiler internal error"" by MGOF01::HSIMON () Tue Apr 29 1997 09:05

The following program reproduced an "Internal Compiler error"
Hans-Werner

Assertion failure:  Compiler internal error - please submit problem report
GEM ASSERTION, Compiler internal error - please submit problem report
Fatal error in: /usr/lib/cmplrs/fort90/decfort90 Terminated

-------8<-----------8<-----------8<-----------8<-----------8<----
! Internal Compiler Error : Digital Fortran 90 V4.1-270
! The critical part of this program is the function c_to_s
! See Fortran 95 COMMITTE DRAFT WG5/N1176 X3J3/96-007
!     14.6.2.1.2 (4) (a)

MODULE iso_varying_string

  TYPE,PUBLIC :: varying_string
    PRIVATE
    CHARACTER(1),DIMENSION(:),POINTER :: cvp => NULL()
  END TYPE varying_string

  INTERFACE var_str
    MODULE PROCEDURE c_to_s
  END INTERFACE

  INTERFACE ASSIGNMENT(=)
    MODULE PROCEDURE s_ass_c, c_ass_s, s_ass_s
  END INTERFACE

 CONTAINS

  FUNCTION c_to_s(c)
    CHARACTER(*),INTENT(IN) :: c
    TYPE(varying_string)    :: c_to_s
    INTEGER                 :: l

    l = LEN(c)
    ALLOCATE( c_to_s%cvp(l) )
    c_to_s%cvp = c

  END FUNCTION c_to_s

  SUBROUTINE s_ass_c(s,c)
    TYPE(varying_string),INTENT(IN OUT) :: s
    CHARACTER(*),INTENT(IN)             :: c

    IF( ASSOCIATED(s%cvp) ) DEALLOCATE( s%cvp )
    ALLOCATE( s%cvp( LEN(c) ) )
    s%cvp = TRANSFER(c,s%cvp)

  END SUBROUTINE s_ass_c

  SUBROUTINE s_ass_s(s,t)
    TYPE(varying_string),INTENT(IN OUT) :: s
    TYPE(varying_string),INTENT(IN    ) :: t

    IF( ASSOCIATED(s%cvp) ) DEALLOCATE( s%cvp )
    ALLOCATE( s%cvp( SIZE(t%cvp) ) )
    s%cvp = t%cvp

  END SUBROUTINE s_ass_s

  PURE SUBROUTINE c_ass_s(c,s)
    CHARACTER(*),INTENT(OUT)        :: c
    TYPE(varying_string),INTENT(IN) :: s
    INTEGER                         :: l

    l = MIN(SIZE(s%cvp),LEN(c))
    c = TRANSFER(s%cvp(:l),c(:l))
    c(l+1:) = ''

  END SUBROUTINE c_ass_s

END MODULE iso_varying_string

PROGRAM t
  USE iso_varying_string
  TYPE(varying_string) :: a
  CHARACTER(2)         :: b
  CHARACTER(3)         :: c
  CHARACTER(4)         :: d

  a = 'abc'
  c = a
  WRITE(*,*) '>',c,'<'
  b = a
  WRITE(*,*) '>',b,'<'
  d = a
  WRITE(*,*) '>',d,'<'
  a = var_str('uvw')
  c = a
  WRITE(*,*) '>',c,'<'

END PROGRAM t

I can't reproduce this in the latest compiler, though I can in the VMS 7.1
compiler - it looks as if this is something we've already fixed.  We're
planning an ECO kit in the next few weeks, so that should take care of it.

				Steve