gcc/testsuite/gfortran.dg/pr61335.f90

! { dg-do run }
! { dg-require-visibility "" }
! { dg-additional-options "-fbounds-check" }
MODULE cp_units

  INTEGER, PARAMETER :: default_string_length=80, dp=KIND(0.0D0)

  LOGICAL, PRIVATE, PARAMETER          :: debug_this_module=.TRUE.
  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_units'
  INTEGER, SAVE, PRIVATE               :: last_unit_id=0, last_unit_set_id=0

  INTEGER, PARAMETER, PUBLIC :: cp_unit_max_kinds=8, cp_unit_basic_desc_length=15,&
       cp_unit_desc_length=cp_unit_max_kinds*cp_unit_basic_desc_length, cp_ukind_max=9

CONTAINS

  FUNCTION cp_to_string(i) RESULT(res)
    INTEGER, INTENT(in)                      :: i
    CHARACTER(len=6)                         :: res

    INTEGER                                  :: iostat
    REAL(KIND=dp)                            :: tmp_r

    IF (i>999999 .OR. i<-99999) THEN
       tmp_r=i
       WRITE (res,fmt='(es6.1)',iostat=iostat) tmp_r
    ELSE
       WRITE (res,fmt='(i6)',iostat=iostat) i
    END IF
    IF (iostat/=0) THEN
       STOP 7
    END IF
  END FUNCTION cp_to_string

  SUBROUTINE cp_unit_create(string)
    CHARACTER(len=*), INTENT(in)             :: string

    CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_create', &
      routineP = moduleN//':'//routineN

    CHARACTER(default_string_length)         :: desc
    CHARACTER(LEN=40)                        :: formatstr
    INTEGER                                  :: i_high, i_low, i_unit, &
                                                len_string, next_power
    INTEGER, DIMENSION(cp_unit_max_kinds)    :: kind_id, power, unit_id
    LOGICAL                                  :: failure

    failure=.FALSE.
    unit_id=0
    kind_id=0
    power=0
    i_low=1
    i_high=1
    len_string=LEN(string)
    i_unit=0
    next_power=1
    DO WHILE(i_low<len_string)
       IF (string(i_low:i_low)/=' ') EXIT
       i_low=i_low+1
    END DO
    i_high=i_low
    DO WHILE(i_high<=len_string)
       IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.&
            string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT
       i_high=i_high+1
    END DO
    DO WHILE(.NOT.failure)
       IF (i_high<=i_low.OR.i_low>len_string) EXIT
       i_unit=i_unit+1
       IF (i_unit>cp_unit_max_kinds) THEN
          EXIT
       END IF
       power(i_unit)=next_power
       ! parse op
       i_low=i_high
       DO WHILE(i_low<=len_string)
          IF (string(i_low:i_low)/=' ') EXIT
          i_low=i_low+1
       END DO
       i_high=i_low
       DO WHILE(i_high<=len_string)
          IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.&
               string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT
          i_high=i_high+1
       END DO
       IF (i_high<i_low.OR.i_low>len_string) EXIT

       IF (i_high<=len_string) THEN
          IF (string(i_low:i_high)=='^') THEN
             i_low=i_high+1
             DO WHILE(i_low<=len_string)
                IF (string(i_low:i_low)/=' ') EXIT
                i_low=i_low+1
             END DO
             i_high=i_low
             DO WHILE(i_high<=len_string)
                SELECT CASE(string(i_high:i_high))
                CASE('+','-','0','1','2','3','4','5','6','7','8','9')
                   i_high=i_high+1
                CASE default
                   EXIT
                END SELECT
             END DO
             IF (i_high<=i_low.OR.i_low>len_string) THEN
                write(6,*) "BUG : XXX"//string//"XXX integer expected"
                STOP 1
                EXIT
             END IF
          END IF
       ENDIF
    END DO
  END SUBROUTINE cp_unit_create

END MODULE cp_units

USE cp_units
CALL cp_unit_create("fs^-1")
END