/* Test various "year 2000" issues - Oct. 7, 1998 */
/* Personal Rexx release 3.0 or higher assumed */
/* Copyright (c) 1998 Quercus Systems. All rights reserved. */

/* determine operating system version */
parse source opsys .
if opsys = 'PCDOS' then
    filename = 'REXX.EXE'
else if opsys = 'OS/2' then
    filename = 'PREXXA.DLL'
else if opsys = 'WIN' then do
    wrxdir = getrexxdirectory()
    if right(wrxdir, 1) \= '\' then
        wrxdir = wrxdir'\'
    if dosdir(wrxdir||'wrexx32.dll') \= '' then
        filename = 'WREXX32.DLL'
    else if dosdir(wrxdir||'wrexx.dll') \= '' then
        filename = 'WREXX.DLL'
    else
        filename = '???'
    end

/* report version of Personal Rexx */
parse version x
say 'This is' x

/* create a file with a date after 1/1/2000 */
fname = '$$Y2K$$.FIL'
if dosdir(fname) \= '' then do
    say 'Test file' fname 'already exists. OK to delete it? (y/n)'
    parse pull reply
    if abbrev('YES', upper(reply), 1) \= 1 then do
        say 'Year 2000 tests cannot be run.'
        exit
        end
    call dosdel fname
    end
call lineout fname, 'Line one'
call lineout fname
if dosdir(fname) = '' then do
    say 'Error creating test file' fname
    say 'Year 2000 tests cannot be run.'
    exit
    end
/* note that old versions of Prexx don't have "dosfdate" */
signal on syntax
call dosfdate fname, '20010102', '120000'
signal off syntax
say fname 'created, dated' dosdir(fname, 'd')
errors = 0

/* test listfile command */
say ''
say 'Testing LISTFILE...'
'listfile' fname '(stem foo.'
date = word(foo.1, 4)
if date \= '01/02/01' then do
    say 'LISTFILE reported file date as' date
    say 'Update to LISTFILE command required for Year-2000 readiness.'
    errors = errors + 1
    end
foo. = ''
'listfile' fname '(since 1/2/01 before 1/3/01 stem foo.'
if foo.0 \= 1 then do
    say 'LISTFILE found' foo.0 'files.'
    say 'LISTFILE BEFORE/SINCE problem -'
    say 'Update to LISTFILE command required for Year-2000 readiness.'
    errors = errors + 1
    end
say 'LISTFILE tests complete'

/* test stream function */
say ''
say 'Testing Stream()...'
date = word(stream(fname, 'c', 'query datetime'), 1)
if date \= '01-02-01' then do
    say 'Stream() reported file date as' date
    say 'Update to' filename 'required for Year-2000 readiness.'
    errors = errors + 1
    end
say 'Stream() tests complete.'

/* test dateconv function */
say ''
say 'Testing Dateconv()...'
year = word(date('n'), 3)
say 'Current year is' year
if left(year, 2) = '19' then do
    date1 = dateconv('1/2/03', 'u', 's')
    date2 = dateconv('1/2/03', 'u', 'b')
    if date1 \= '20030102' | date2 \= '731216' then do
        say '1/2/03 converted to:' date1 date2
        say 'Update to' filename 'required for Year-2000 readiness.'
        errors = errors + 1
        end
    end
else do
    date1 = dateconv('1/2/97', 'u', 's')
    date2 = dateconv('1/2/97', 'u', 'b')
    if date1 \= '19970102' | date2 \= '729025' then do
        say '1/2/97 converted to:' date1 date2
        say 'Update to' filename 'required for Year-2000 readiness.'
        errors = errors + 1
        end
    end
say 'Dateconv() tests completed.'

/* finish */
say ''
say 'There were' errors 'errors detected.'
if errors = 0 then
    say 'This version of Personal Rexx appears to be Year-2000 ready.'
else do
    say 'This version of Personal Rexx is not Year-2000 ready.'
    if filename = 'REXX.EXE' then
        say 'Your REXX.EXE file should be dated on or after Sep. 29, 1998.'
    else if filename = 'PREXXA.DLL' then
        say 'Your PREXXA.DLL file should be dated on or after Sep. 21, 1998.'
    else if filename = 'WREXX.DLL' then
        say 'Your WREXX.DLL file should be dated on or after Oct. 2, 1998.'
    else if filename = 'WREXX32.DLL' then
        say 'Your WREXX32.DLL file should be dated on or after Oct. 5, 1998.'
    say 'Please email support@quercus-sys.com for assistance.'
    say 'Include the output of this test in your message.'
    end
call dosdel fname
exit

/* syntax error handler for dosfdate */
syntax:
say 'Error using Dosfdate() function.'
say 'This release of Personal Rexx is back level and not Year-2000 ready.'
exit