-- FILE:     DOSERROR.EX
-- PROJECT:  Lib2 (Unit testing)
-- PURPOSE:  Verify the results of DOSERROR.E library.
-- AUTHOR:   Shian Lee
-- VERSION:  1.00  February/3/2022
-- LANGUAGE: Euphoria version 3.1.1 (www.RapidEuphoria311.com)
-- PLATFORM: DOS32
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * Tested on FreeDOS 1.3rc5, DOSBox, and Linux.
--           * Still need to test on Windows-XP (*not* in a virtual-machine).
-----------------------------------------------------------------------------


include graphics.e
include machine2.e
include file2.e
include get.e

include doserror.e



constant DOSBOX = floor(prompt_number("\nRun test on DOSBox [0,1]? ", {0,1}))


procedure color(integer back, integer fore)
    bk_color(back)
    text_color(fore)
end procedure

procedure normal(object newline)
    color(BLACK, WHITE)
    puts(1, newline)
end procedure

procedure OK_FAIL(boolean ok)
    text_color(iif(ok, BRIGHT_GREEN, BRIGHT_RED))
    puts(1, iif(ok, "[OK]", "[FAIL]") & ' ')
end procedure

procedure allow(boolean yes, integer cycles)
-- set allow_error()    
    color(MAGENTA, iif(yes, YELLOW, BRIGHT_WHITE))
    for i = 1 to cycles do
	allow_error(yes)
	printf(1, "allow_error(%d) -- (%d times)\r", {yes, i})
    end for
    normal('\n')
end procedure

procedure abort_fail(boolean ok)
-- abort on any error   
    integer nul
    
    if not ok then
	nul = set_drive_map('a') -- restore A:
	nul = chdrive('C') -- restore safe drive
	pause() 
	normal("")
	? 1 / 0 -- test failed -- create ex.err
    end if
end procedure

procedure check_err(boolean error, integer cycles)
-- test check_error()    
-- note: looks like DOSBox doesn't have an active critical-error interrupt.
    sequence s, pos
    boolean ok, is_dos
    
    is_dos = OS_DOS32 and not DOSBOX
    s = EMPTY
    pos = get_position()
    for i = 1 to cycles do
	s &= check_error()
	ok = equal(s, iif(is_dos, error, 0) & repeat(0, i - 1))
	position(pos[1], pos[2])
	OK_FAIL(ok)
	printf(1, "check_error(): %s", {sprint(s)}) 
	abort_fail(ok)
    end for
    normal('\n')
end procedure

procedure check_map(sequence set_get, integer ret, integer map)
-- test set_drive_map(), get_drive_map()    
-- note: there are no mapped drives on DOSBox, but DOS interrupt works
    integer dr
    boolean ok
    
    dr = set_get[2]
    ok = map = iif(OS_DOS32, iif(DOSBOX, upper(dr), ret), dr)
    OK_FAIL(ok)
    printf(1, "%set_drive_map('%s') = %s", {set_get[1], dr, map})
    abort_fail(ok)
    normal('\n')
end procedure



--bookmark: Start stress test;

constant CYCLES = 9 -- how many times to run test?

integer fn
boolean al, ce -- allow, critical-error

for i = 1 to CYCLES do
    normal("")
    clear_screen()
    
    color(BLUE, iif(remainder(i, 2), BRIGHT_WHITE, BRIGHT_CYAN))
    printf(1, " * Cycle %02d * \n", i)
    
    al = find(i, {1, 5}) > 0  -- some cycles don't use Euphoria handler
    ce = not al -- critical-error occures only when using Euphoria handler
    if al then
	color(CYAN, BLACK + 16)
	puts(1, " Press 'F' for critical-error prompt... \n")
    end if
    
    normal("")
    check_err(FALSE, i)
    allow(TRUE, i)
    check_err(FALSE, i)
    allow(al, i)
    check_map("sB", 'B', set_drive_map('B')) -- avoid DOS message

    -- drive B: not ready (make sure B: is not ready...)
    printf(1, "chdir(\"B:\"): %d\t", chdir("B:"))
    check_err(ce, i)
 
    -- drive B: not ready
    printf(1, "dir(\"B:\"): %d\t", sequence(dir("B:")))
    check_err(ce, i)
 
    -- drive B: not ready
    printf(1, "chdrive('b'): %d\t", chdrive('b'))
    check_err(ce, i)
    
    -- drive B: not ready
    printf(1, "full_filename(\"B:x.txt\"): %d\t", 
		    sequence(full_filename("B:x.txt")))
    check_err(ce, i)

    -- printer not ready (turn off your printer...)
    fn = open("LPT1", "w")
    printf(1, "open(\"LPT1\", \"w\"): %d\t", fn)
    puts(fn, "abc\n") 
    check_err(ce, i)
    close(fn)
    
    -- test drive map (assuming A: and B: are mapped drive)
    check_map("gc", 'C', get_drive_map('c')) -- normally not mapped
    check_map("sc", 'C', set_drive_map('c'))
    check_map("sZ", 'Z', set_drive_map('Z'))
    
    check_map("sa", 'A', set_drive_map('a')) -- A,B - today usualy mapped
    check_map("gA", 'A', get_drive_map('A'))
    check_map("gB", 'A', get_drive_map('B'))
    check_map("sB", 'B', set_drive_map('B'))
    check_map("ga", 'B', get_drive_map('a'))
    check_map("sa", 'A', set_drive_map('a')) -- last, restore A:

    sleep(1)
end for

puts(1, "  *** [OK] TEST DONE ***  ")


-- End of file.
