Subversion Repositories openrisc

! { dg-do run }

! { dg-options "-std=gnu" }

! PR47567 Wrong output for small absolute values with F editing

! Test case provided by Thomas Henlich

call verify_fmt(1.2)

call verify_fmt(-0.1)

call verify_fmt(1e-7)

call verify_fmt(1e-6)

call verify_fmt(1e-5)

call verify_fmt(1e-4)

call verify_fmt(1e-3)

call verify_fmt(1e-2)

call verify_fmt(-1e-7)

call verify_fmt(-1e-6)

call verify_fmt(-1e-5)

call verify_fmt(-1e-4)

call verify_fmt(-1e-3)

call verify_fmt(-1e-2)

call verify_fmt(tiny(0.0))

call verify_fmt(-tiny(0.0))

call verify_fmt(0.0)

call verify_fmt(-0.0)

call verify_fmt(100.0)

call verify_fmt(.12345)

call verify_fmt(1.2345)

call verify_fmt(12.345)

call verify_fmt(123.45)

call verify_fmt(1234.5)

call verify_fmt(12345.6)

call verify_fmt(123456.7)

call verify_fmt(99.999)

call verify_fmt(-100.0)

call verify_fmt(-99.999)

end

! loop through values for w, d

subroutine verify_fmt(x)

    real, intent(in) :: x

    integer :: w, d

    character(len=80) :: str, str0

    integer :: len, len0

    character(len=80) :: fmt_w_d

    logical :: result, have_num, verify_fmt_w_d

    do d = 0, 10

        have_num = .false.

        do w = 1, 20

            str = fmt_w_d(x, w, d)

            len = len_trim(str)

            result = verify_fmt_w_d(x, str, len, w, d)

            if (.not. have_num .and. result) then

                have_num = .true.

                str0 = fmt_w_d(x, 0, d)

                len0 = len_trim(str0)

                if (len /= len0) then

                    call errormsg(x, str0, len0, 0, d, "selected width is wrong")

                else

                    if (str(:len) /= str0(:len0)) call errormsg(x, str0, len0, 0, d, "output is wrong")

                end if

            end if

        end do

    end do

end subroutine

! checks for standard-compliance, returns .true. if field contains number, .false. on overflow

function verify_fmt_w_d(x, str, len, w, d)

    real, intent(in) :: x

    character(len=80), intent(in) :: str

    integer, intent(in) :: len

    integer, intent(in) :: w, d

    logical :: verify_fmt_w_d

    integer :: pos

    character :: decimal_sep = "."

    verify_fmt_w_d = .false.

    ! check if string is all asterisks

    pos = verify(str(:len), "*")

    if (pos == 0) return

    ! check if string contains a digit

    pos = scan(str(:len), "0123456789")

    if (pos == 0) call errormsg(x, str, len, w, d, "no digits")

    ! contains decimal separator?

    pos = index(str(:len), decimal_sep)

    if (pos == 0) call errormsg(x, str, len, w, d, "no decimal separator")

    ! negative and starts with minus?

    if (sign(1., x) < 0.) then

        pos = verify(str, " ")

        if (pos == 0) call errormsg(x, str, len, w, d, "only spaces")

        if (str(pos:pos) /= "-") call errormsg(x, str, len, w, d, "no minus sign")

    end if

    verify_fmt_w_d = .true.

end function

function fmt_w_d(x, w, d)

    real, intent(in) :: x

    integer, intent(in) :: w, d

    character(len=*) :: fmt_w_d

    character(len=10) :: fmt, make_fmt

    fmt = make_fmt(w, d)

    write (fmt_w_d, fmt) x

end function

function make_fmt(w, d)

    integer, intent(in) :: w, d

    character(len=10) :: make_fmt

    write (make_fmt,'("(f",i0,".",i0,")")') w, d

end function

subroutine errormsg(x, str, len, w, d, reason)

    real, intent(in) :: x

    character(len=80), intent(in) :: str

    integer, intent(in) :: len, w, d

    character(len=*), intent(in) :: reason

    integer :: fmt_len

    character(len=10) :: fmt, make_fmt

    fmt = make_fmt(w, d)

    fmt_len = len_trim(fmt)

    !print *, "print '", fmt(:fmt_len), "', ", x, " ! => ", str(:len), ": ", reason

    call abort

end subroutine