program long_test
  use n3long
  implicit none
  call roundtrip1
  call roundtrip2
  call roundtrip3
  call add
  call mul
  call div
contains

  subroutine div2(cj, ck, cm)
    character(*), intent(in):: cj, ck, cm
    type(LONG):: j, k, m
    integer:: stat
    call long_dfmt_hex(cj, j, stat)
    if (stat <= len(cj)) stop 16
    if (hex(j) /= cj) then
      print "('long_dfmt_hex fail',a,'/=',a)", hex(j), cj
      stop 16
    endif
    call long_dfmt_hex(ck, k, stat)
    if (stat <= len(ck)) stop 16
    if (hex(k) /= ck) stop 'long_dfmt_hex fail'
    m = j / k
    print "(a,' / ',a,' = ',a)", hex(j), hex(k), hex(m)
    if (hex(m) /= cm) stop 'long_mul fail'
  end subroutine

  subroutine div
    call div2("0FFBD84CC99CF999", "0553F2C443345333", "0000000000000003")
    call div2("0000100080000000", "0000000010008000", "0000000000010000")
    call div2("0FFFFFFF80000001", "000000003FFFFFFF", "000000003FFFFFFF")
    print *, 'div ok'
  end subroutine

  subroutine mul2(cj, ck, cm)
    character(*), intent(in):: cj, ck, cm
    type(LONG):: j, k, m
    integer:: stat
    call long_dfmt_hex(cj, j, stat)
    if (stat <= len(cj)) stop 16
    if (hex(j) /= cj) then
      print "('long_dfmt_hex fail',a,'/=',a)", hex(j), cj
      stop 16
    endif
    call long_dfmt_hex(ck, k, stat)
    if (stat <= len(ck)) stop 16
    if (hex(k) /= ck) stop 'long_dfmt_hex fail'
    m = j * k
    print "(a,' * ',a,' = ',a)", hex(j), hex(k), hex(m)
    if (hex(m) /= cm) stop 'long_mul fail'
  end subroutine

  subroutine mul
    call mul2("0000000000000003", "0000000000000007", "0000000000000015")
    call mul2("000000003FFFFFFF", "000000003FFFFFFF", "0FFFFFFF80000001")
    call mul2("0000001020304050", "0000000000010000", "0010203040500000")
    call mul2("553F2C4433453331", "0000000000000003", "FFBD84CC99CF9993")
    print *, 'mul ok'
  end subroutine

  subroutine add
    call add1
    call add2("0000000000000003", "0000000000000007", "000000000000000A")
    call add2("000000000000FFFF", "0000000000000007", "0000000000010006")
    call add2("00000000FF2FFFFF", "00000000FFFF0005", "00000001FF2F0004")
    print *, 'add test ok'
  end subroutine

  subroutine add2(c1, c2, c3)
    character(*), intent(in):: c1, c2, c3
    type(LONG):: i1, i2, i3
    integer:: stat
    call long_dfmt_hex(c1, i1, stat)
    call long_dfmt_hex(c2, i2, stat)
    i3 = i1 + i2
    if (hex(i3) /= c3) then
      print "(a,' + ',a,' = ',a)", hex(i1), hex(i2), hex(i3)
      stop 16
    endif
  end subroutine

  subroutine add1
    type(LONG):: i, j, k
    double precision:: x, y
    i = 1
    j = 2.0d0 ** 40
    k = i + j
    k = i + k
    k = k - j
    if (int(k) /= 2) stop "add 1 doesn't work well"
    i = 2**30 - 1
    j = i
    k = i + j
    x = i
    y = k
    if (x * 2 /= y) then
      print *, 'wrong carry in addition:', x * 2, y, x * 2 - y
      print *, hex(i), hex(k)
      stop 16
    endif
  end subroutine

  subroutine rt3test(str)
    character(*), intent(in):: str
    type(long):: l
    character(16):: str2
    integer:: s
    call long_dfmt_hex(str, l, s)
    str2 = hex(l)
    if (str /= str2) then
      print *, '#mismatch: ', str, ' ', str2
      stop 16
    endif
  end subroutine

  subroutine roundtrip3
    call rt3test('0000000000000000')
    call rt3test('0000000000000001')
    call rt3test('0000000098765432')
    call rt3test('0000000198765432')
    call rt3test('FEDCBA9876543210')
    print *, 'roundtrip3 ok'
  end subroutine

  subroutine roundtrip2
    type(LONG):: a
    integer:: i
    double precision:: b, c
    do, i = 0, 63
      b = 2.0d0 ** i
      a = b
      c = a
      if (b /= c) then
        print "('DLD round trip: 2**',i2,2(a,g16.9))", i, '=', b, hex(a), c
        stop 16
      endif
    enddo
    print *, "roundtrip2 ok"
  end subroutine

  subroutine roundtrip1
    type(LONG):: a
    integer:: i, j, k
    do, i = 0, 30
      j = 2 ** i
      a = j
      k = a
      if (j /= k) then
        print *, "!i-l-i round trip fails:", j, k
        stop 16
      endif
    enddo
    print *, "roundtrip1 ok"
  end subroutine

end program