-- FILE:     TESTDATE.EX
-- PROJECT:  Lib2 (Unit testing)
-- PURPOSE:  Verify the results of DATETIME.E library using MS-VBDOS.
-- AUTHOR:   Shian Lee
-- VERSION:  1.00  Saturday, October/12/2019
-- LANGUAGE: Euphoria version 3.1.1 (http://www.RapidEuphoria311.com)
-- PLATFORM: DOS32 (VBDOS is a DOS program)
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * See also DATETIME.TXT.
--           * Created using QE 2.3.9/EDU 2.33 for DOS, on FreeDOS 1.2.
--           * After tests you should delete the last *.OUT files manually.
-- HISTORY:  1.00: Initial version.
-----------------------------------------------------------------------------


--------------------------- Start of user defined ---------------------------

-- These files should be created in the current (test) directory
constant CURRENT_DRV = "C:"         -- e.g. "C:"
constant CURRENT_DIR = "C:\\WORK"   -- e.g. "C:\\TEST"

-- How many random tests to make (default=10000, which is 10000*2+100)?
constant MAX_TESTS = 10000

---------------------------- End of user defined ----------------------------


include graphics.e
include file.e
include machine.e

-- Lib2 1.32+
include machine2.e
include datetime.e
include math.e

-- test file names (for Euphoria/VBDOS)
constant VBDOS_PROG  = "TESTDATE.BAS",  -- VB source code program
	 EU_OUT_FILE = "EU_TEST.OUT",   -- EU output for compare
	 VB_OUT_FILE = "VB_TEST.OUT"    -- VB output for compare

constant
	EOF = -1,   -- file I/O return value
	SCREEN = 1, -- device number
	ENTER = 13, -- DOS/Windows ENTER key
	ESCAPE = 27 -- Esc key

-- with trace

procedure put_normal(object st)
    bk_color(BLACK)
    text_color(WHITE)
    puts(SCREEN, st)
    puts(SCREEN, '\n')
end procedure

procedure put_bright(object st)
    bk_color(BLACK)
    text_color(BRIGHT_WHITE)
    puts(SCREEN, st)
    put_normal(EMPTY)
end procedure

procedure put_err(object st)
    bk_color(BLACK)
    text_color(YELLOW)
    puts(SCREEN, st)
    put_normal(EMPTY)
end procedure

procedure enter_to_continue()
    bk_color(BLACK)
    text_color(BRIGHT_CYAN)
    puts(SCREEN, "* Press ENTER key to continue... ")
    clear_keyboard()
    while get_key() != ENTER do
    end while
    put_normal(EMPTY)
end procedure

procedure put_fatal(object st)
    bk_color(RED)
    text_color(YELLOW)
    puts(SCREEN, st)
    put_normal(EMPTY)
    enter_to_continue()
    crash(EMPTY)    -- see the file "ex.err" for details;
		    -- all opened files are closed on crash().
end procedure

procedure append_line(integer fn, sequence dt, integer line_number)
-- dt is {year, month, day, hour, minute, second}
    atom s1, s2
    sequence f64, di

    -- verify that atom_to_float64() can encode and decode
    -- date-time serial number without losing any precision
    s1  = datetime(dt)
    f64 = atom_to_float64(s1)
    s2  = float64_to_atom(f64)
    if s1 != s2 then
	put_fatal(sprintf("datetime() != float64_to_atom(): %.15g != %.15g",
		    {s1, s2}))
    end if

    di = dateinfo(s1)

    -- append line to out file (in the *same* format of VBDOS)
    printf(fn, "%05d;[[%s]]=<<%s>>=||%s||\n", {
	    line_number,
	    sprint(dt),
	    sprint(di[1..6]),
	    sprintd("%yyyy-%mmm-%dd %ddd %hh:%tt:%ss", s1)
	}
    )
end procedure

-- Supported date-time range (note: other dates are calculated the same!).
-- VBDOS     : 1/1/1753 to 31/12/2078. (1932 is Julian Calendar, I assume).
-- EU-LIB2   : 1/1/1900 to 31/12/4900. (Gregorian Calendar).
-- TEST-RANGE: 1/1/1933 to 31/12/2078. (Gregorian Calendar range).
constant
    VBDOS_START_YEAR = 1900 + 50, -- try not to go under 1933...
    VBDOS_END_YEAR   = 2078 - 20

procedure create_eu_out_file(integer fn)
    integer y, m, d, h, t, s -- {year, month, day, hour, minute, second}
    sequence r, r2

    -- test random date-times:
    for line_number = 1 to MAX_TESTS do
	y = rand_range(VBDOS_START_YEAR, VBDOS_END_YEAR)
	m = rand_range(1,     200) - 100
	d = rand_range(1,    2000) - 1000
	h = rand_range(1,   20000) - 10000
	t = rand_range(1,   20000) - 10000
	s = rand_range(1,   20000) - 10000

	append_line(fn, {y, m, d, h, t, s}, line_number)
    end for

    -- test edge date-times:
    for line_number = MAX_TESTS + 1 to MAX_TESTS * 2 do
	y = rand_range(VBDOS_START_YEAR, VBDOS_END_YEAR)
	r = shuffle({-1, 0, 1, 11, 12, 13})   m = r[1]
	r = shuffle({-1, 0, 1, 30, 31, 32})   d = r[1]
	r = shuffle({-1, 0, 1, 23, 24, 25})   h = r[1]
	r = shuffle({-1, 0, 1, 59, 60, 61})   t = r[1]
	r = shuffle({-1, 0, 1, 59, 60, 61})   s = r[1]

	append_line(fn, {y, m, d, h, t, s}, line_number)
    end for

    -- test now():
    for line_number = MAX_TESTS * 2 + 1 to MAX_TESTS * 2 + 100 do
	r = dateinfo(now())
	r2 = date()
	r2[1] += 1900
	if equal(r[1..8], r2[1..8]) then
	    append_line(fn, r[1..6], line_number)
	else
	    put_fatal("now() & date() not equal:\n\t" &
		sprint(r) & " != " & sprint(r2))
	end if
    end for
end procedure

procedure run_vbdos()
    integer exit_code

    put_normal(EMPTY)
    put_bright( "* Let's run '" & VBDOS_PROG & "' with VBDOS.")
    put_normal("  (1. Press F5 to run '" & VBDOS_PROG & "').")
    put_normal("  (2. Then Exit VBDOS with Alt+F4).")
    put_normal("  (*  VBDOS must be in the system PATH).")
    enter_to_continue()

    exit_code = system_exec("VBDOS " & VBDOS_PROG, 2)

    if exit_code then
	put_fatal(sprintf("VBDOS returned exit code %d ! abort...", exit_code))
    end if
end procedure

procedure compare_out_files()
    integer fn_eu, fn_vb, key
    object line_eu, line_vb
    boolean success

    put_normal("\n\n")
    put_bright("* Comparing '" & EU_OUT_FILE & "' & '" & VB_OUT_FILE & "'...")

    fn_eu = open(EU_OUT_FILE, "r")
    if fn_eu = EOF then
	put_fatal("Cannot open '" & EU_OUT_FILE & "' for reading! abort...")
    end if
    fn_vb = open(VB_OUT_FILE, "r")
    if fn_vb = EOF then
	put_fatal("Cannot open '" & VB_OUT_FILE & "' for reading! abort...")
    end if

    success = TRUE  -- default is TRUE

    while TRUE do
	line_eu = gets(fn_eu)
	line_vb = gets(fn_vb)

	if equal(line_eu, line_vb) then
	    if atom(line_eu) then
		exit
	    end if
	elsif atom(line_eu) or atom(line_vb) then
	    success = FALSE

	    if atom(line_eu) then
		put_err("End of file '" & EU_OUT_FILE & "' reached too soon!")
	    else
		put_err("End of file '" & VB_OUT_FILE & "' reached too soon!")
	    end if
	    exit
	else -- lines are different
	    success = FALSE

	    text_color(BRIGHT_GREEN)
	    puts(SCREEN, EU_OUT_FILE & ": " & line_eu & '\n')
	    text_color(YELLOW)
	    puts(SCREEN, VB_OUT_FILE & ": " & line_vb & '\n')

	    text_color(WHITE)
	    puts(SCREEN, "[ Enter=continue, Esc=stop ] ...\n")

	    clear_keyboard()
	    key = EOF
	    while key != ENTER and key != ESCAPE do
		key = get_key()
	    end while
	    if key = ESCAPE then
		exit -- don't display more different lines
	    end if
	end if
    end while

    close(fn_eu)
    close(fn_vb)

    put_normal(EMPTY)
    if success then
	bk_color(GREEN)
	text_color(BRIGHT_WHITE)
	puts(SCREEN, "***  TEST SUCCESSFUL  ***")
	put_normal(EMPTY)
	put_bright(EU_OUT_FILE & " and " & VB_OUT_FILE & " are equal.")
    else
	bk_color(RED)
	text_color(YELLOW)
	puts(SCREEN, "<<< TEST FAILED ! >>>")
	put_normal(EMPTY)
	put_err(EU_OUT_FILE & " and " & VB_OUT_FILE & " are NOT equal!")
    end if
    put_normal(EMPTY)

    enter_to_continue()
end procedure

procedure initialize_test()
    put_bright("* Setting directory & deleting previous test files...")

    -- change to working drive and directory
    system(CURRENT_DRV, 2)
    system("CD " & CURRENT_DIR, 2)

    -- delete old files
    system("DEL " & EU_OUT_FILE, 2)
    system("DEL " & VB_OUT_FILE, 2)

    put_normal("\n\n\n\n\n") -- FreeDOS "DEL" using direct screen access...
end procedure

procedure run_test()
    integer fn

    put_normal(EMPTY)
    clear_screen()

    put_bright("* TESTING \"DATETIME.E\" (Lib2), using MS-VBDOS PRO 1.00")
    put_normal("  (Press Ctrl+C to stop at anytime).")
    enter_to_continue()
    put_normal(EMPTY)

    initialize_test()

    put_bright( "* Creating files in current directory: " & current_dir())
    fn = open(EU_OUT_FILE, "w")
    if fn = EOF then
	put_fatal("Cannot open '" & EU_OUT_FILE & "' for writing! abort...")
    else
	create_eu_out_file(fn)
	close(fn)
	put_normal("Test file '" & EU_OUT_FILE & "' created successfully...")
    end if

    -- create out file using VBDOS (F5=Run; Alt+F4=Exit VBDOS)
    run_vbdos()
    put_normal(EMPTY)

    -- verify that test result is OK, Compare EU_OUT_FILE & VB_OUT_FILE
    compare_out_files()
end procedure

run_test()
