program MJD_DATE { www.merlyn.demon.co.uk } ;

{ This program has two uses; as a test for unit DateProx.pas & others,
  and as a means of performing some date calculations.  Its input checks
  are less stringent than those of DateProx should be.

  A single command-line parameter is taken as an MJD; three as YYYY MM DD;
  none gives interactive input.

  The Delphi Magazine #34 (June 1998) pp.24 ff. refers to MJD_DATE; much
  of the code cited is now in the unit DateProx, in the same directory;
  this program tests DateProx, and is less optimised.

  Define NoCrt to avoid Crt initialisation bug (loses 25/50 line swap)

  Define Pedt at your own risk, in lieu of Crt.

  [Without Crt,] can be driven from a redirected file of commands. See
  also program BAT_DATE, intended for use in batch files.

  Occurrences of RunError are failed sanity checks at MJD 50000.

  Written and predominantly tested with Borland Pascal 7.

  Compiles with Delphi 3 "DCC32 -CC MJD_DATE" and runs, seemingly correctly.

  Compiled with TMT Pascal v3.30, but failed at runtime where lines like
  that containing 'TMTbug' are unfixed !?  OK so far in TMT v3.50.

  Note that relative timings can be quite different with different compilers.

  Some speed-checks have been set to suit :
  Borland Pascal 486/33, Delphi PII/300.

  if LOOKUP is defined at compile time. fast conversions are tested.


  Read also the comment in dateprox.pas. }


{$IFDEF PEDT}{$DEFINE NoCrt}{$ENDIF}

{$I VERSION.PAS}

{$IFDEF DELPHI}{$DEFINE NoCrt}{$ENDIF}

uses
  {$IFDEF JDtest} Jul_Date, {$ENDIF}
  {$IFDEF PEDT} TextSet, {$ENDIF}
  {$IFDEF WINDOWS} WinCrt, WinDos, {$ENDIF}
  {$IFNDEF WINDOWS}
    {$IFNDEF NoCrt} Crt, {$ENDIF}
    {$IFDEF PASCAL} Dos, {$ENDIF}
    {$IFDEF DELPHI}
      {$IFDEF DTWeek}
      { http://home.t-online.de/home/PeterJHaas/Download/DTWeek.zip }
      DTWeek, {$ENDIF}
    SysUtils, Windows, {$ENDIF}
  {$ENDIF}
  DateProx ;

{$IFDEF PEDT}{$UNDEF NoCrt}{$ENDIF}

{ GetTickCount can be any function:longint giving a time count }

{$IFDEF BORPAS}
function GetTickCount : longint ; assembler ;
asm
    mov es,[Seg0040] ;
  @1: mov ax,[es:$6c] ; mov dx,[es:$6e] ; mov cl,[es:$70]
    cmp ax,[es:$6c] ; jne @1
    cmp cl,0 ; je @2
    add ax,$B0 ; adc dx,$18 ;
  @2:
    end {GetTickCount} ;
{$ENDIF BORPAS}

{$IFDEF __TMT__}
function GetTickCount : longint ;
begin GetTickCount := MemL[$046C] end {GetTickCount} ;
{$ENDIF __TMT__}


function SynchTickCount : longint ;
var T1, T2 : longint ;
begin
  T1 := GetTickCount ;
  repeat T2 := GetTickCount until T2 <> T1 ;
  SynchTickCount := T2 end {SynchTickCount} ;


const BRFO : string [Succ(Ord(High(ChangeDate)))] = 'BRFO' ;


function ChangeSym(const CD : ChangeDate) : char ;
begin ChangeSym := BRFO[Succ(Ord(CD))] end {ChangeSym} ;


function WrCal(const Cal : Calendar) : string ;
var S : char ;
begin if Cal=Civil then S := ChangeSym(ChangeDay) else S := #32 ;
  WrCal := CalName[Cal] + #32 + S + #32 end {WrCal} ;


procedure Lairt(Opts : Options ; IBMj : boolean ;
  Yr : IntYear ; Mo : Part ; Dy : word) ;
var Y : IntYear ; M, D : Part ; DDD : OrdDate ; MJD : MJDate ;
{$IFDEF XX__TMT__} XX : WkDys ; {$ENDIF}
begin with Opts do begin
    Write(WrCal(Cal)) ;
    {$IFDEF DELPHI} MJD := 0 {avoids Delphi 3 warning } ; {$ENDIF}
    case IBMj of
      false : begin
        Write(DateStr(Astr, Yr, Mo, Dy)) ;
        Write(' YMD->MJD: ') ;
        MJD := YMD_to_MJD(Opts, Yr, Mo, Dy) ;

        {$IFDEF XX__TMT__ - TMT v3.30 bug - OK in v3.50}
        XX := MJDDayOfWeek(MJD) ;
        Write(MJD:9, WkDstr[XX]:4, #32) ;
        {$ELSE}
        Write(MJD:9, WkDstr[MJDDayOfWeek(MJD)]:4, #32) {TMTbug} ;
        {$ENDIF}

        if (Yr=1995) and (Mo=10) and (Dy=10) and (Cal=Gregorian) then
          if MJD<>50000 then RunError(231) ;
        Write(' MJD->YMD: ') ;
        MJD_to_YMD(Opts, MJD, Y, M, D) ;
        Write(DateStr(Astr, Y, M, D)) ;
        if (Y<>Yr) or (M<>Mo) or (D<>Dy) then ReportAnError(236) ;
        end ;
      true : begin
        Write(JDateStr(Astr, Yr, Dy)) ;
        Write(' YD->MJD: ') ;
        MJD := YD_to_MJD(Opts, Yr, Dy) ;

        {$IFDEF XX__TMT__ - TMT v3.30 bug}
        XX := MJDDayOfWeek(MJD) ;
        Write(MJD:9, WkDstr[XX]:4, #32) ;
        {$ELSE}
        Write(MJD:9, WkDstr[MJDDayOfWeek(MJD)]:4, #32) ;
        {$ENDIF}

        if (Yr=1995) and (Dy=283) and (Cal=Gregorian) then
          if MJD<>50000 then RunError(231) ;
        Write(' MJD->YD: ') ;
        MJD_to_YD(Opts, MJD, Y, DDD) ;
        Write(JDateStr(Astr, Y, DDD)) ;
        if (Y<>Yr) or (DDD<>Dy) then ReportAnError(236) ;
        end ;
      end {IBMj} ;
    Writeln ;
    end end {Lairt} ;


procedure Trial(Opts : Options ; IBMj : boolean ; MJD : MJDate) ;
var Yr : IntYear ; Mo, Dy : Part ; Q : MJDate ; DDD : OrdDate ; DW : WkDys ;
begin with Opts do begin
    Write(WrCal(Cal), MJD:10) ;
    {$IFDEF DELPHI} Q := 0 {avoids Delphi 3 warning } ; {$ENDIF}
    case IBMj of
      false : begin Write('  MJD->YMD: ') ;
        MJD_to_YMD(Opts, MJD, Yr, Mo, Dy) ; DW := MJDDayOfWeek(MJD) ;
        Write(DateStr(Astr, Yr, Mo, Dy), Ord(DW):3, WkDstr[DW]:4, ' ') ;
        if (MJD=50000) and (Cal=Gregorian) then
          if (Yr<>1995) or (Mo<>10) or (Dy<>10) or (DW<>Tue) then
          RunError(234) ;
        Write(' YMD->MJD: ') ;
        Q := YMD_to_MJD(Opts, Yr, Mo, Dy) end ;
      true : begin Write('  MJD->YD: ') ;
        MJD_to_YD(Opts, MJD, Yr, DDD) ; DW := MJDDayOfWeek(MJD) ;
        Write(JDateStr(Astr, Yr, DDD), Ord(DW):3, WkDstr[DW]:4, ' ') ;
        if (MJD=50000) and (Cal=Gregorian) then
          if (Yr<>1995) or (DDD<>283) or (DW<>Tue) then RunError(234) ;
        Write(' YD->MJD: ') ;
        Q := YD_to_MJD(Opts, Yr, DDD) end ;
      end {IBMj} ;
    Write(Q:9, '':1) ;
    if Q<>MJD then ReportAnError(237) ;
    Writeln end end {Trial} ;


procedure TestSet(Opts : Options ; IBMj : boolean) ;
const Trys : array [1..8] of MJDate = (50141, 50141+365, 50141+1461, -1,
  Pred(LastBrit), Pred(LastRome), -678579, -2400002) ;
var K : integer ; M : MJDate ;
begin Writeln(' TestSet :') ;
  for K := Low(Trys) to High(Trys) do
    for M := Trys[K] to Trys[K]+3 do Trial(Opts, IBMj, M) ;
  end {TestSet} ;


procedure IErr ; begin Writeln(' Input Error!'^G) end {IErr} ;


procedure CalcNum(Opts : Options ; IBMj : boolean ; S : string) ;
{$IFNDEF __TMT__} FAR ; {$ENDIF}
var MJDay : MJDate ; J : integer ;
begin Val(S, MJDay, J) ;
  if J=0 then Trial(Opts, IBMj, MJDay) else IErr ;
  end {CalcNum} ;


procedure CalcStr(Opts : Options ; IBMj : boolean ; S : string) ;
{$IFNDEF __TMT__} FAR ; {$ENDIF}
var Yr : IntYear ; Mo, Dy : Part ; DDD : OrdDate ;
begin with Opts do case IBMj of
    true  : if not ReadYDdate(Astr, S, Yr, DDD) then
      begin IErr ; EXIT end ;
    false : if not ReadYMDdate(Astr, S, Yr, Mo, Dy) then
      begin IErr ; EXIT end else DDD := Dy ;
    end {IBMj} ;
  Lairt(Opts, IBMj, Yr, Mo, DDD) ;
  end {CalcStr} ;


procedure FirstThursTests(Opts : Options) ;
var Yr, YI : IntYear ;
begin Writeln(' FirstThursTests :') ;
  Write(' 26 First Thursdays from Year ? ') ; Readln(YI) ;
  for Yr := YI to YI+25 do Write(LZ(Yr mod 100):3) ;
  Writeln ;
  for Yr := YI to YI+25 do Write(First_Thurs(Opts, Yr):3) ;
  Writeln ;
  for Yr := YI to YI+25 do Write(NthXdayOfMonth(Opts, Yr, 1, 1, Thu):3) ;
  Writeln ;
  for Yr := YI to YI+25 do Write(Nth_XdayOfMonth(Opts, Yr, 1, 1, Thu):3) ;
  Writeln ;
  for Yr := YI to YI+25 do
    if Yr <  Low(NearYear) then Write('':3) else
    if Yr <= High(NearYear) then Write(PC_ThuOne(Yr):3) ;
  Writeln ;
  for Yr := YI to YI+25 do
    if Yr <  Low(NearYear) then Write('':3) else
    if Yr <= High(NearYear) then Write(PC_Thu_One(Yr):3) ;
  Writeln ;
  end {FirstThursTests} ;


procedure Mar1List(Opts : Options) ;
var Yr : WrdYear ;
begin Writeln(' Mar1List :') ;
  for Yr := 1980 to 2020 do Lairt(Opts, false, Yr, 3, 1) ;
  end {Mar1List} ;


procedure FloatJD(Opts : Options) ;
var R, Q, Frc : extended ; MJD : MJDate ; J : integer ;
Yr : IntYear ; Mo, Dy, Hr, Mn, Sc : Part ;
WYr, WMo, WDy, WHr, WMn, WSc : word ;
S : string[10] ;
begin Writeln(' FloatJD :') ;
  Writeln('    Float-JDN ->  Int-JDN & Frac-JDN ->    Real-JDN  &  Diff') ;
  for J := 1 to 10 do begin
    R := (Random-0.5) * 3e7 ;
    Write(R:13:3) ;
    RJDNtoMJDandFrac(R, MJD, Frc) ;
    Write(MJD:12, Frc:11:6) ;
    Q := MJDandFracToRJDN(MJD, Frc) ;
    Writeln(Q:15:3, Q-R:9:3) ;
    end ;
  writeln('    Float-JDN ->  Calendar   Date and Time, GMT',
    '   ->    Real-JDN  &  Diff') ;
  for J := -2 to 6 do begin
    R := 1000000.63*J ;
    Write(R:13:3) ;
    RJDNtoMJDandFrac(R, MJD, Frc) ;
    Write('':4, CalName[TrueCal(Opts, MJD)], ' ') ;
    MJD_to_YMD(Opts, MJD, Yr, Mo, Dy) ;
    Seconds_to_HMS(Round(Frc*86400.0), Hr, Mn, Sc) ;
    Write(Datestr(Opts.Astr, Yr, Mo, Dy), TimeStr(Hr, Mn, Sc)) ;
    Frc := HMS_to_Seconds(Hr, Mn, Sc)/86400.0 ;
    MJD := YMD_to_MJD(Opts, Yr, Mo, Dy) ;
    Q := MJDandFracToRJDN(MJD, Frc) ;
    Writeln(Q:15:3, Q-R:9:3)
    end ;
  GetNow(WYr, WMo, WDy, WHr, WMn, WSc) ;
  Write('It is ', Datestr(false, WYr, WMo, WDy), TimeStr(WHr, WMn, WSc)) ;
  Frc := HMS_to_Seconds(WHr, WMn, WSc)/86400.0 ;
  MJD := YMDtoMJD(WYr, WMo, WDy) { Greg } ;
  Writeln(', JDN = ', MJDandFracToRJDN(MJD, Frc):1:6,
    ' ignoring offset from GMT.') ;
  repeat Write('  JDN (0.0 terminates) ? ') ; Readln(R) ;
    RJDNtoMJDandFrac(R, MJD, Frc) ;
    Write('':30, CalName[TrueCal(Opts, MJD)], ' ') ;
    MJD_to_YMD(Opts, MJD, Yr, Mo, Dy) ;
    Seconds_to_HMS(Round(Frc*86400.0), Hr, Mn, Sc) ;
    Str(Frc:0:6, S) ; Delete(S, 1, 1) ;
    Writeln(Datestr(Opts.Astr, Yr, Mo, Dy), #8, S,
      #32, TimeStr(Hr, Mn, Sc), ' GMT') ;
    until R=0 ;
  writeln ;
  repeat
    Write(#32, WrCal(Opts.Cal), '   Y M D H M S (M=0 to exit) ?????? ') ;
    Readln(Yr, Mo, Dy, Hr, Mn, Sc) ; if Mo=0 then BREAK ;
    MJD := YMD_to_MJD(Opts, Yr, Mo, Dy) ;
    Frc := HMS_to_Seconds(Hr, Mn, Sc)/86400 ;
  Writeln('JDN = ':30, MJDandFracToRJDN(MJD, Frc):1:6,
    ' ignoring offset from GMT.') ;
    until false ;

  writeln end {FloatJD} ;


function AskYMD
  (const Cal : Calendar ; var Yr : IntYear ; var M, D : Part) : boolean ;
begin
  Write(#32, WrCal(Cal), '   Y M D (Y=M=D=0 to exit) ??? ') ;
  Readln(Yr, M, D) ;
  AskYMD := (Yr<>0) or (M<>0) or (D<>0) end {AskYMD} ;


procedure DayOfYearTest(const Opts : Options) ;
var YYYY, Yr : IntYear ; DDD : OrdDate ; M, D : Part ;
begin Writeln(' DayOfYearTest :') ;
  while AskYMD(Opts.Cal, Yr, M, D) do begin
    MJD_to_YD(Opts, YMD_to_MJD(Opts, Yr, M, D), YYYY, DDD) ;
    Writeln('YMD->MJD->YD:':20, DDD:5,
      'DayOfYear:':16, DayOfYear(Opts, Yr, M, D):5) ;
    end end {DayOfYearTest} ;


procedure IncDateTest(const Opts : Options) ;
var Yr : IntYear ; M, D : Part ; By : MJDate ;
begin Writeln(' IncDateTest :') ;
 with Opts do while AskYMD(Cal, Yr, M, D) do begin
    Write(DateStr(Astr, Yr, M, D):50, ' Increment ? ') ; Readln(By) ;
    Incr_Date(Opts, Yr, M, D, By) ;
    Writeln(DateStr(Astr, Yr, M, D):50) ;
    end end {IncDateTest} ;


procedure TillTest(const Opts : Options) ;
var Y1, Y2, DY : IntYear ; M1, M2, DM, D1, D2, DD : Part ;
begin Writeln(' TillTest :') ;
  Writeln(' N.B.: As months are of differing lengths, ',
    'division of a general interval'^M^J, '  into Y M D',
    ' can never be wholly satisfactory.  But see ISO-8601.') ;
  with Opts do
    while AskYMD(Cal, Y1, M1, D1) and AskYMD(Cal, Y2, M2, D2) do begin
    Writeln(' Difference:':55,
      Date_Diff(Opts, Y2, M2, D2, Y1, M1, D1):12, ' days') ;
    YMD_Diff(Opts, Y1, M1, D1, Y2, M2, D2, DY, DM, DD) ;
    Writeln(' Difference:':55, DY:5, ' Y, ', DM, ' M, ', DD, ' D.') end ;
  end {TillTest} ;


procedure AskRomanYears(const Opts : Options) ;
begin
  if Opts.Cal=Civil then begin
    Write('  False before BC45.  With Roman errors BC45-AD8 (0/1) ? ') ;
    Readln(byte(RomanYears)) ;
    if RomanYears then Writeln(^G'   Maybe incomplete?'^G) ;
    end ;
  end {AskRomanYears} ;


procedure ValidTest(const Opts : Options) ;
var MJD : longint ; Yr : IntYear ; M, D, X1, X2 : Part ;
B : boolean ;
begin Writeln(' ValidTest :') ;
  AskRomanYears(Opts) ;
  if (Opts.Cal=Civil) and (ChangeDay=Other) then
    Writeln(^G'  ValidDate not tested for Other Civil change year!'^G) ;
  while AskYMD(Opts.Cal, Yr, M, D) do begin
    MJD := YMD_to_MJD(Opts, Yr, M, D) ;
    X1 := ISODoW1(MJD) ;
    B := Valid_Date(Opts, Yr, M, D) ;
    Write(' Leap_Year:', Leap_Year(Opts, Yr):6,
      ', Last Day in Month', Ulti_Mo(Opts, Yr, M):3,
      ', Valid:', B:6) ;
    if B then Write(', ', WkDstr[WkDys(X1)]) ;
    if Yr>0 then if TrueCal(Opts, MJD)=Gregorian then begin
      X2 := SvenDOW(Yr, M, D) ; Write(', SvenDOW OK:', X1=X2:6) end ;

    Writeln ;
    if {(Yr>1900) and (Yr<2100)} YearNear(Yr) then
      if PC_Day_Valid(Yr, M, D)<>B then
      Writeln(' ** PC_Day_Valid ', not B, ' **') ;

    end ;
  end {ValidTest} ;


function Day
  (const Opts : Options ; const Yr : IntYear ; const M, D : Part) : string ;
begin Day := WkDstr[WkDys(ISODoW1(YMD_to_MJD(Opts, Yr, M, D)))] end {Day} ;


procedure WT
  (const Opts : Options ; const Yr : IntYear ; const M, D : Part) ;
var N : TWeekNo ; Y : IntYear ; Dy : Part ;
{$IFDEF DELPHI} YW : WrdYear ; {$ENDIF}
begin
  Write(DateStr(Opts.Astr, Yr, M, D):45) ;
  if Valid_Date(Opts, Yr, M, D) then begin
    Write(Day(Opts, Yr, M, D):4, ' -> ') ;
    Y := Yr ;
    ISO_Week_Num(Opts, N, Y, M, D) ;
    Writeln('ISOWN', Y:9, N:3) ;
    Y := Yr ;
    ISO_Week_Num_Day(Opts, Yr, M, D, Y, N, Dy) ;
    Writeln('ISOWND':59, Y:8, N:3, Dy:3) ;
    Y := Yr ;
    CTWeekNo_Day({Opts,} Yr, M, D, Y, N, Dy) ;
    Writeln('CTWND':59, Y:8, N:3, Dy:3) ;
    Y := Yr ;
    JSWeekNo(Opts, N, Y, M, D) ;
    Writeln('JSWeekNo':58, Y:9, N:3) ;

    {$IFDEF DELPHI}
    if {(Yr>1900) and (Yr<2100)} YearNear(Yr) then begin
      Y := Yr ;
      ISO_Week_NumD(N, Y, M, D) ;
      Writeln('Delphi A':58, Y:9, N:3) ;
      YW := Yr ;
      JSWeekNoD(N, YW, M, D) ;
      Writeln('Delphi B':58, YW:9, N:3) ;
      end ;
    {$ENDIF DELPHI}

    end else Writeln('Invalid Date') ;
  end {WT} ;


procedure GWN(const Opts : Options ; const Yr : IntYear ;
  const M, D, MS, DS : Part ; const FD : WkDys) ;
var N : TWeekNo ; Y : IntYear ;
begin
  Write(DateStr(Opts.Astr, Yr, M, D):45, Day(Opts, Yr, M, D):4, ' -> ') ;
  if Valid_Date(Opts, Yr, M, D) then begin Y := Yr ;
    Gen_Week_Num(Opts, N, Y, M, D, MS, DS, FD) ;
    Writeln(Y:9, N:3, Day(Opts, Yr, M, D):4) ;
    end else Writeln('Invalid Date') ;
  end {GWN} ;


procedure More ; begin Write(' <cr>') ; Readln end {More} ;


procedure WN_JG_Yr ;
var N : TWeekNo ; M, D : Part ;
var Yr : IntYear ;
begin with ChangeData[ChangeDay] do begin
    for D := 1 to 31 do begin if D=20 then More ;
      Yr := CY ; M := CMth ; WT(CivCal, Yr, M, D) end ;
    More ;
    for N := -8 to +8 do begin
      MJD_to_YMD(CivCal, LastJulianMJD[ChangeDay]+N, Yr, M, D) ;
      WT(CivCal, Yr, M, D) end ;
    More ;
    for D := 24 to 31 do begin
      Yr := CY ; M := 12 ; WT(CivCal, Yr, M, D) end ;
    for D := 1 to 8 do begin
      Yr := Succ(CY) ; M := 1 ; WT(CivCal, Yr, M, D) end ;
    end end {WN_JG_Yr} ;


const VerStr = '  Verify for the non-[UK,RC] Jul-Greg year !!!'^G ;

procedure ISO_WeekNumTest(const Opts : options) ;
var Yr : IntYear ; M, D : Part ;
begin
  if ChangeDay=Other then Writeln(VerStr) ;
  while AskYMD(Opts.Cal, Yr, M, D) do
    {$IFDEF wntest} for Yr := Yr to Yr+21 do {$ENDIF} WT(Opts, Yr, M, D) ;
  end {ISO_WeekNumTest} ;


procedure Gen_WeekNumTest(const Opts : options) ;
var Yr : IntYear ; M, D, MS, DS : Part ; FD : WkDys ;
begin
  if ChangeDay=Other then Writeln(VerStr) ;
  Write('  First day of week (Sun=0..Sat=6) ? ') ; Readln(byte(FD)) ;
  Write(WkDstr[FD]:5,
    '.  Month, Day that must be in Week 1 ?? ') ; Readln(MS, DS) ;
  while AskYMD(Opts.Cal, Yr, M, D) do GWN(Opts, Yr, M, D, MS, DS, FD) ;
  end {Gen_WeekNumTest} ;


procedure TestISOWN(const Opts : Options) ;
var MJD, M2 : longint ; Yr, IY : IntYear ; M, D, ID : Part ; WN : TWeekNo ;
begin Writeln(' Test Year-Week-Day conversions,',
    ' 11000 days, MJD YMD YND MJD :') ;
  for MJD := 50000 to 61000 do begin Write(#13, MJD:8) ;
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    Write(Yr:8, '-', LZ(M), '-', LZ(D)) ;
    ISO_Week_Num_Day(Opts, Yr, M, D, IY, WN, ID) ;
    Write(IY:8, '-', LZ(WN), ID:2) ;
    M2 := ISO_WNDtoMJD(Opts, IY, WN, ID) ;
    Write(MJD:9) ;
    if M2=MJD then Write('  OK') else begin
      Write('  ? ') ; Readln ;
      end ;
    end ;
  Writeln end {TestISOWN} ;


procedure ISOcheck(Years : longint) ;
var MJD0, MJD1 : MJDate ; Last : longint ; xY, Y, Yr : IntYear ;
xD, D, Dy, Mo : Part ; xN, N : TWeekNo ;
const First = 50000 ;
begin
  Last := First + (Years*1461) div 4 ;
  Writeln('  Testing ISO weeks, MJD ', First, -Last, ' :') ;
  Y := 0 ; N := 0 ; D := 0 ;
  for MJD0 := First to Last do begin Write(MJD0:8, ^M) ;
    xY := Y ; xN := N ; xD := D ;
    MJDtoYMD(MJD0, Yr, Mo, Dy) ;
    ISO_Week_Num_Day(GrgCal, Yr, Mo, Dy, Y, N, D) ;

    if (D<>xD+1) or (N<>xN)   or (Y<>xY) then
      if (D<>1)  or (N<>xN+1) or (Y<>xY)   or (xD<>7) then
      if (D<>1)  or (N<>1)    or (Y<>xY+1) or not (xN in [52..53]) then
      if MJD0<>First then begin
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
        '   ISO YND', Y:6, N:3, D:3, '   Previous', xY:6, xN:3, xD:3) ;
      CONTINUE end ;

    MJD1 := ISO_WNDtoMJD(GrgCal, Y, N, D) ;
    if MJD0<>MJD1 then
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
      '   ISO YND', Y:6, N:3, D:3, '   MJD1', MJD1:6, MJD0-MJD1:8) ;
    end ;
  end {ISOcheck} ;


procedure RevenueCheck(Years : longint) ;
var MJD0, MJD1 : MJDate ; Last : longint ; xY, Y, Yr : IntYear ;
xD, D, Mo, Dy : Part ; xM, M, xN, N : TWeekNo ;
const First = 50000 ;
{} procedure Q(const Z : string) ;
{} begin Writeln('  Testing Revenue ', Z, ', MJD ', First, -Last, ' :') end ;
begin
  Last := First + (Years*1461) div 4 ;
  Q('Weeks') ; Y := 0 ; N := 0 ; D := 0 ;
  for MJD0 := First to Last do begin Write(MJD0:8, ^M) ;
    xY := Y ; xN := N ; xD := D ;
    MJDtoYMD(MJD0, Yr, Mo, Dy) ;
    UKTaxWeekNo(Yr, Mo, Dy, Y, N, D) ;

    if (D<>xD+1) or (N<>xN)   or (Y<>xY) then
      if (D<>1)  or (N<>xN+1) or (Y<>xY)   or (xD<>7) then
      if (D<>1)  or (N<>1)    or (Y<>xY+1) or not (xN in [52..53]) then
      if MJD0<>First then begin
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
        '   Tax YND', Y:6, N:3, D:3, '   Previous', xY:6, xN:3, xD:3) ;
      CONTINUE end ;

    MJD1 := UKTax_WNDtoMJD(Y, N, D) ;
    if MJD0<>MJD1 then
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
      '   Tax YND', Y:6, N:3, D:3, '   MJD1', MJD1:6, MJD0-MJD1:8) ;
    end ;
  Q('Months') ; Y := 0 ; M := 0 ; D := 0 ;
  for MJD0 := First to Last do begin Write(MJD0:8, ^M) ;
    xY := Y ; xM := M ; xD := D ;
    MJDtoYMD(MJD0, Yr, Mo, Dy) ;
    UKTaxMonthDay(Yr, Mo, Dy, Y, M, D) ;

    if (D<>xD+1) or (M<>xM)   or (Y<>xY) then
      if (D<>1)  or (M<>xM+1) or (Y<>xY)   or not (xD in [28..31]) then
      if (D<>1)  or (M<>1)    or (Y<>xY+1) or (xM<>12) then
      if MJD0<>First then begin
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
        '   Tax YMD', Y:6, M:3, D:3, '   Previous', xY:6, xM:3, xD:3) ;
      CONTINUE end ;

    MJD1 := UKTax_WMDtoMJD(Y, M, D) ;
    if MJD0<>MJD1 then
      Writeln('MJD0', MJD0:6, '   Cal YMD', Yr:6, Mo:3, Dy:3,
      '   Tax YMD', Y:6, M:3, D:3, '   MJD1', MJD1:6, MJD0-MJD1:8) ;
    end ;
  end {RevenueCheck} ;


procedure TestWeekNumSpeed(const Opts : options) ;
var MJD, T, Repts, Ov : longint ; W : WNrec ;
Yr, YY : IntYear ;
{$IFDEF DELPHI} {$IFDEF DTWEEK} NW, {$ENDIF}
  YW, MW, DW : word ; QQ : TDateTime ; {$ENDIF}
M, D, DS : Part ; N, XN : TWeekNo ;
begin
  Write(' Timing : Overhead = ') ; Repts := 1 ;
  repeat
    T := GetTickCount ;
    for MJD := 50000 to 50000+10227*Repts do begin
      MJD_to_YMD(Opts, MJD, Yr, M, D) ;
      end {MJD} ;
    Ov := GetTickCount-T ;
    Write(Ov, ', ') ;
    if Ov > {$IFDEF PASCAL} 10 {$ENDIF} {$IFDEF DELPHI} 285 {$ENDIF}
      then BREAK else Repts := Repts*2 ;
    until false ;
  {$IFDEF DELPHIxxx 20080119}
    if Repts>285 then Repts := 285 { 4 digit range } ; {$ENDIF}
  Writeln('will be removed :') ;
  Writeln(' Timing, over ', 28*Repts,
    ' years; times (Pascal, *55ms; Delphi, *1ms) :') ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    Gen_Week_Num(Opts, N, Yr, M, D, 1, 4, Mon) ;
    end {MJD} ;
  Writeln('  Gen_Week_Num = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    ISO_Week_Num(Opts, N, Yr, M, D) ;
    end {MJD} ;
  Writeln('  ISO_Week_Num = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    ISO_Week_Num_Day(Opts, Yr, M, D, YY, XN, DS) ;
    end {MJD} ;
  Writeln('  ISO_Week_Num_Day = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    JSWeekNo(Opts, N, Yr, M, D) ;
    end {MJD} ;
  Writeln('  JSWeekNo = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    CTWeekNo_Day({Opts,} Yr, M, D, YY, XN, DS) ;
    end {MJD} ;
  Writeln('  CTWeekNo_Day = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    CTWeekNo(Opts, N, Yr, M, D) ;              {???}
    (*    {$IFDEF PASCAL} longint(W) {$ENDIF} {$IFDEF DELPHI} W {$ENDIF}
      := CTWeekNoF(Opts, Yr, M, D) ; (********)
    end {MJD} ;
  Writeln('  CTWeekNo = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    { CTWeekNo(Opts, N, Yr, M, D) ; }
    {$IFDEF PASCAL} longint(W) {$ENDIF} {$IFDEF DELPHI} W {$ENDIF}
      := CTWeekNoF(Opts, Yr, M, D) ; (********)
    end {MJD} ;
  Writeln('  CTWeekNoF = ', GetTickCount-T-Ov) ;

  {$IFDEF DELPHI}

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    YW := Yr ; MW := M ; DW := D ;
    JSWeekNoD(N, YW, MW, DW) ;
    end {MJD} ;
  Writeln('  JSWeekNoD = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    ISODTtoYWD(MJD-15018, YW, MW, DW) { 20080119 } ;
    end {MJD} ;
  Writeln('  ISODTtoYWD = ', GetTickCount-T-Ov) ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    QQ := ISOYWDtoDT(YW, MW, DW) { 20080119 } ;
    end {MJD} ;
  Writeln('  ISOYWDtoDT = ', GetTickCount-T-Ov) ;

  {$IFDEF DTWEEK}

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    DateToWeek(EncodeDate(Yr, M, D), YW, NW, DW) ;
    end {MJD} ;
  Writeln('  DTWEEK = ', GetTickCount-T-Ov, ' unfair?') ;

  T := GetTickCount ;
  for MJD := 50000 to 50000+10227*Repts do begin
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    DateToWeek(MJD-15018, YW, NW, DW) ;
    end {MJD} ;
  Writeln('  DTWEEK = ', GetTickCount-T-Ov, ' unfair?') ;

  {$ENDIF DTWEEK}

  {$ENDIF DELPHI}

  end {TestWeekNumSpeed} ;


procedure TestWeekNumGeneral(const Opts : options) ;
var MJD : longint ; K : word ; Yr, XY, YY : IntYear ;
M, D, MM, Dy, MS, DS : Part ; FD : WkDys ; N, XN : TWeekNo ;
begin
  Write('Test Gen_Week_Num exhaustively (0/1) ? ') ; Readln(K) ;
  if K=1 then begin
    Writeln(' Next line shows columnar count-to :') ;
    Writeln(' 12 31 Sat   MJD 60327') ;
    for MS := 1 to 12 do for DS := 1 to 31 do
      for FD := Sun0 to Sat do begin K := 0 ; XN := 0 ; XY := 0 ;
      for MJD := 50000-100 to 50000+10227+100 do begin
        Write(^M, MS:3, DS:3, WkDstr[FD]:4, MJD:12) ;
        MJD_to_YMD(Opts, MJD, Yr, M, D) ;
        Write(' = ', DateStr(Opts.Astr, Yr, M, D)) ;
        Gen_Week_Num(Opts, N, Yr, M, D, MS, DS, FD) ;
        Write(Yr:6, N:3) ;
        YY := Yr ; WkNo_Start(Opts, N, YY, MM, Dy, MS, DS, FD) ;
        Write('':3, DateStr(Opts.Astr, YY, MM, Dy)) ;

        if N=XN then Inc(K) else K := 0 ;
        if MJD>=50000 then begin
          if K=0 then if MJDDayOfWeek(MJD)<>FD then Writeln(^G'  Wrong flip'^G) ;
          if Yr<>XY then if N<>1 then Writeln(^G'  New "Year" not Week 1'^G) ;
          if (M=MS) and (D=DS) then
            if N<>1 then Writeln(^G'  Given Day not in Week 1'^G) ;
          if (Dy=DS) and (MM=MS) then if N<>1 then
            Writeln(^G'  Start not in Week 1'^G) ;
          end {>=} ;

        XN := N ; XY := Yr end {MJD} ;
      end {MS DS FD} ;
    Writeln(^M^J'Done.') ;
    end {K=1} ;
  end {TestWeekNumGeneral} ;


procedure TestWeekNumAccuracy(const Opts : options) ;
var MJD : longint ; W : WNrec ; GenY, Y, Yr : IntYear ; SN : TWeekNo ;
{$IFDEF DELPHI} {$IFDEF DTWEEK} NW, Q1, Q2, Q3, {$ENDIF DTWEEK}
  {} YW, MW, DW : word ; X : longint ; {$ENDIF DELPHI}
Mo, Dy, D : Part ; GenN, N : TWeekNo ;
begin
  if ChangeDay=Other then Writeln(VerStr) ;




  Writeln(' Trying, for 28 years,  Gen_WN  ',
    {$IFNDEF DELPHI} 'ISO_WN  ', {$ENDIF}
    'ISOWND    JSWN   CTWND    CTWN   CTWNF',
    ':') ;

  for MJD := 50000 to 50000+10227 do begin
    Write(^M'  MJD', MJD:6) ;
    MJD_to_YMD(Opts, MJD, Yr, Mo, Dy) ;
    Write(' ', Copy(DateStr(Opts.Astr, Yr, Mo, Dy), 4, 255)) ;

    GenY := Yr ;
    Gen_Week_Num(Opts, GenN, GenY, Mo, Dy, 1, 4, Mon) { REFERENCE } ;
    Write(GenY:4, '-', LZ(GenN)) ;

    {$IFNDEF DELPHI}
    Y := Yr ;
    ISO_Week_Num(Opts, N, Y, Mo, Dy) ;
    Write(Y:5, '-', LZ(N)) ;
    if (Y<>GenY) or (N<>GenN) then Writeln(^G' Wrong'^G) ;
    {$ENDIF}

    Y := Yr ;
    ISO_Week_Num_Day(Opts, Y, Mo, Dy, Y, N, D) ;
    Write(Y:5, '-', LZ(N)) ;
    if (Y<>GenY) or (N<>GenN) then Writeln(^G' Wrong'^G) ;

    Y := Yr ;
    JSWeekNo(Opts, N, Y, Mo, Dy) ;
    Write(Y:5, '-', LZ(N)) ;
    if (Y<>GenY) or (N<>GenN) then Writeln(^G' Wrong'^G) ;

    Y := Yr ;
    CTWeekNo_Day({Opts,} Y, Mo, Dy, Y, N, D) ;
    Write(Y:5, '-', LZ(N)) ;
    if (Y<>GenY) or (N<>GenN) then Writeln(^G' Wrong'^G) ;


    Y := Yr ;
    CTWeekNo(Opts, SN, Y, Mo, Dy) ;
    Write(Y:5, '-', LZ(SN)) ;
    if (Y<>GenY) or (SN<>GenN) then Writeln(^G'  Wrong'^G) ;


    Y := Yr ;
    {$IFDEF PASCAL} longint(W) {$ENDIF} {$IFDEF DELPHI} W {$ENDIF}
      := CTWeekNoF(Opts, Y, Mo, Dy) ;
    Write(W.YN:5, '-', LZ(W.WN)) ;
    if (W.YN<>GenY) or (W.WN<>GenN) then Writeln(^G'  Wrong'^G) ;

    end {MJD} ;


  {$IFDEF DELPHI}

  Writeln ;

  Writeln('DELPHI ONLY :') ;

  Writeln(' Trying, for 28 years,',
    '  Gen_WN   JSWND ISODTtoYWD ISOYWDtoDT',
    {$IFDEF DTWEEK} '  DTWEEK', {$ENDIF}
    ':') ;

  for MJD := 50000 to 50000+10227 do begin
    Write(^M'  MJD', MJD:6) ;
    MJD_to_YMD(Opts, MJD, Yr, Mo, Dy) ;
    Write(' ', Copy(DateStr(Opts.Astr, Yr, Mo, Dy), 4, 255)) ;

    GenY := Yr ;
    Gen_Week_Num(Opts, GenN, GenY, Mo, Dy, 1, 4, Mon) { REFERENCE } ;
    Write(GenY:4, '-', LZ(GenN)) ;

    YW := Yr ; MW := Mo ; DW := Dy ;
    JSWeekNoD(N, YW, MW, DW) ;
    {} Write(YW:5, '-', LZ(N)) ;
    if (YW<>GenY) or (N<>GenN) then Writeln(^G' Wrong'^G) ;

    ISODTtoYWD(MJD-15018, YW, MW, DW) ;
    {} Write(YW:8, '-', LZ(N)) ;
    if (YW<>GenY) or (MW<>GenN) then Writeln(^G' Wrong'^G) ;

    X := Round(ISOYWDtoDT(GenY, GenN, DW) + 15018) ; // MW DW ?
    {} Write(X:11) ;
    if (X<>MJD) then Writeln(^G' Wrong'^G) ;

    {$IFDEF DTWEEK}

    DateToWeek(EncodeDate(Yr, Mo, Dy), YW, NW, DW) ;
    {} Write(YW:5, '-', LZ(NW)) ;
    DecodeDate(WeekToDate(YW, NW, DW), Q1, Q2, Q3) ;
    if (Q1<>Yr) or (Q2<>Mo) or (Q3<>Dy)
      then Writeln(^G'  DTWEEK wrong'^G) ;

    {$ENDIF DTWEEK}

    end {MJD} ;

  {$ENDIF DELPHI}

  Writeln end {TestWeekNumAccuracy} ;


procedure TestWeekNum(const Opts : options) ;
begin
  TestWeekNumAccuracy(Opts) ;
  TestWeekNumSpeed(Opts) ;
  TestISOWN(Opts) ;
  {  TestWeekNumGeneral(Opts) ; }
  end {TestWeekNum} ;


procedure WkNo_Start_Test(const Opts : Options) ;
var Yr : IntYear ; N : TWeekNo ; M, D : Part ;
const FD : WkDys = Mon ; MS : Part = 1 ; DS : Part = 4 ;
begin
  repeat Write(
      '    WeekStart ', WkDstr[FD], ', Week 1 contains M D ', MS, ' ', DS,
      '    Change (0/1) ? ') ; Readln(D) ; if D=0 then BREAK ;
    Write('    WeekStart (Sun=0..Sat=7)?, Week 1 contains Month? Day? ') ;
    Readln(byte(FD), MS, DS) ;
    until false ;
  repeat
    Write('    Year, WkNo (0 0 to end) ?? ') ; Readln(Yr, N) ;
    if (Yr=0) and (N=0) then EXIT ;
    WkNo_Start(Opts, N, Yr, M, D, MS, DS, FD) ;
    Writeln('Week starts ':28, DateStr(Opts.Astr, Yr, M, D),
      Day(Opts, Yr, M, D)) ;
    until false end {WkNo_Start_Test} ;


procedure SecondsTest ;
var D : word ; H, M, S : Part ; Sx : longint ;
begin Writeln(' SecondsTest :') ;
  repeat
    Write(' Seconds (0 to end) ? ') ; Readln(Sx) ;
    Seconds_to_HMS(Seconds_to_DS(Sx, D), H, M, S) ;
    Write(Sx:25, ' s -> ', D:5, ' days ', TimeStr(H, M, S), ' -> ') ;
    Writeln(DS_to_Seconds(D, HMS_to_Seconds(H, M, S)):10, ' s.') ;
    until Sx=0 end {SecondsTest} ;


procedure YearMatches { for date setback } ;
var Yr, YP, Y1, Y2 : IntYear ; L : boolean ; Fnd, Mo : byte ; D, D0 : WkDys ;
begin Writeln(' YearMatches :') ;
  Writeln(' From Year1 to Year2, Month, gives 12-month matches:') ;
  repeat
    Write('  Gregorian Year1, Year2, Month (Month=0 ends) ?? ') ;
    Readln(Y1, Y2, Mo) ; if Mo=0 then EXIT ;

    Write('   Year from  Day Feb29    12-month matches') ;
    if Mo=3 then Write(' (ignoring terminal Feb29)') ;
    Writeln(' ...') ;
    for Yr := Y1 to Y2 do if Yr<>0 then begin
      Write(DateStr(false, Yr, Mo, 1)) ;
      L := Leap_Year(GrgCal, Yr+Ord(Mo>2)) ;
      D := MJDDayOfWeek(YMDtoMJD(Yr, Mo, 1)) ;
      Write(WkDstr[D], L:6, ' =') ;
      Fnd := 0 ; YP := Yr ;
      repeat Dec(YP) ;
        if YP<>0 then if (MJDDayOfWeek(YMDtoMJD(YP, Mo, 1))=D)
          and ( (Mo=3) or (Leap_Year(GrgCal, YP+Ord(Mo>2))=L) )
          then begin Write(YP:6) ; Inc(Fnd) end ;
        until (Fnd=9) ;
      Writeln end ;

    Writeln(^M^J^M^J, Months[Mo], '1 Leap? Years ...') ;
    for L := false to true do begin
      { Writeln('Leap Years : ', L) ; }
      for D := Mon to Sun7 do begin D0 := D ; if D0 = Sun7 then D0 := Sun0 ;
        Write(WkDStr[D]:4, L:6) ; Fnd := 0 ;
        for Yr := Y1 to Y2 do if L = Leap_Year(GrgCal, Yr) then
          if D0 = MJDDayOfWeek(YMDtoMJD(Yr, Mo, 1)) then begin
          if Fnd = 12 then begin Write(^M^J, '':10) ; Fnd := 0 end ;
          Inc(Fnd) ;
          Write(Yr:5) ; end {Yr} ;
        Writeln end {D} ;
      Writeln end {L} ;

    until false end {YearMatches} ;


procedure InTest(const A : boolean ; const IBMJln : boolean) ;
var S : string ; YY : IntYear ; MM, DD : Part ; DDD : OrdDate ;
begin Writeln(' InTest :') ;
  repeat
    Write(' Date String (empty to end) ? ') ; Readln(S) ;
    if S='' then EXIT ;
    case IBMJln of
      false :
      if ReadYMDdate(A, S, YY, MM, DD)
        then Writeln(DateStr(A, YY, MM, DD):40)
        else Writeln(^G'Too Bad !':40) ;
      true :
      if ReadYDdate(A, S, YY, DDD)
        then Writeln(JDateStr(A, YY, DDD):40)
        else Writeln(^G'No Good !':40) ;
      end ;
    until false ;
  end {InTest} ;


procedure GregJulEasterDiff ;
var F : text ;
GMJD, JMJD, Max, YL, YJ, D : longint ; Y : WrdYear ; GM, GD, JM, JD : Part ;
begin
  Assign(F, 'EastDiff.txt') ; Rewrite(F) ;
  Write('   Writing to EastDiff.txt ') ; Max := 10000 ;
  Writeln(F, ' A.D.  Gregorian   MJD  Julian      MJD  Diff SameDate') ;
  for Y := 1 to Max do begin
    if Lo(Y)=0 then Write(Hi(Max-Y):3, ^H^H^H) { progress } ;
    Write(F, Y:5) ;
    GregorianEaster(Y, GM, GD) ;
    GMJD := YMD_to_MJD(GrgCal, Y, GM, GD) ;
    Write(F, '  G:', GM:2, '-', LZ(GD), GMJD:8) ;
    JulianEaster(Y, JM, JD) ;
    JMJD := YMD_to_MJD(JulCal, Y, JM, JD) ;
    Write(F, '  J:', JM:2, '-', LZ(JD), JMJD:8) ;
    Write(F, JMJD-GMJD:6) ;
    if (GM=JM) and (GD=JD) then Write(F, '   <---') ;
    Writeln(F) end {Y} ;
  Close(F) ;
  Writeln ;

  Assign(F, 'LongSame.txt') ; Rewrite(F) ;
  Write('   Writing to LongSame.txt ') ; Max := 150000 ;
  Writeln(F, '      Gregorian        MJD      Julian           MJD') ;
  YJ := 1582 ;
  for YL := YJ to Max do begin
    if Lo(YL)=0 then Write((Max-YL) shr 8:3, ^H^H^H) ;
    LongGregorianEaster(YL, GM, GD) ;
    GMJD := LongYMD_to_MJD(GrgCal, YL, GM, GD) ;
    LongJulianEaster(YJ, JM, JD) ;
    JMJD := LongYMD_to_MJD(JulCal, YJ, JM, JD) ;
    D := JMJD-GMJD ;
    if D=0 then
      Writeln(F, '  G:', YL:6, '-', LZ(GM), '-', LZ(GD), GMJD:10,
      {}         '  J:', YJ:6, '-', LZ(JM), '-', LZ(JD), JMJD:10) ;
    if Abs(D)<300 then Inc(YJ) else Writeln(F) ;
    end {YL} ;
  Close(F) ;

  end {GregJulEasterDiff} ;


type EProcT = procedure (const Yr : WrdYear ; var Mo, Dy : Part) ;


procedure PaschTable(const N, S : string ; const P : byte ; EProc : EProcT) ;
var F : text ; St : string ;
Q : longint ; Y1, Y2, Yr, XY, YY : word ; J, K : integer ;
MinGap, MaxGap, MaxGapAll {MinGapAll=5}, MinGY, MaxGY : word ;
Mo, Dy, M, D : Part ; X, MGX : byte ;
begin
  {$IFDEF DELPHI} MinGY := 0 ; MaxGY := 0 ; MGX := 0 ; {$ENDIF}
  Val(Copy(S, 1, P-1), Y1, J) ; Val(Copy(S, P, 255), Y2, K) ;
  if (J<>0) or (K<>0) then begin Writeln(' Error'^G) ; EXIT end ;
  Write('  Output Device / File ? ') ; Readln(St) ;
  Assign(F, St) ; Rewrite(F) ;
  Writeln(F, ^M^J'MJD_DATE.PAS  -  ', N, ' Easter Sundays in ', Y1, -Y2) ;

  Write(F, ^M^J^M^J, '+':4) ;
  for X := 0 to 9 do Write(F, X:6) ; Writeln(F) ;
  for Yr := (Y1 div 10)*10 to Y2 do begin
    if (Yr mod 10)=0 then Write(F, ^M^J, Yr:5, #32) ;
    EProc(Yr, M, D) ; Write(F, MonthS[M]:4,  LZ(D)) ;
    end ;

  MaxGapAll := 0 ;
  Write(F, ^M^J^M^J^M^J^M^J' Date    Year  ....') ; Q := 0 ;
  for X := 114 to 148 { alter if Aleppo prevails } do begin J := 0 ;
    MinGap := $FFFF ; MaxGap := 0 ; XY := 0 ;
    Mo := X div 31 ; Dy := Succ(X mod 31) ;
    Write(F, ^M^J, MonthS[Mo], LZ(Dy):3, #32) ;
    for Yr := Y1 to Y2 do begin EProc(Yr, M, D) ;
      if (D=Dy) and (M=Mo) then begin
        if J=10 then begin J := 0 ; Write(F, ^M^J, '':7) end ;
        Write(F, #32, Yr:5) ;
        if XY>0 then begin
          YY := Yr-XY ;
          if MinGap>YY then begin MinGap := YY ; MinGY := XY end ;
          if MaxGap<YY then begin MaxGap := YY ; MaxGY := XY end ;
          end {XY>0} ;
        XY := Yr ;
        Inc(Q) ; Inc(J) end {match} ;
      end {Yr} ;
    Write(F, ^M^J,
      '     Min Gap', MinGap:6, MinGY:6,
      '     Max Gap', MaxGap:6, MaxGY:6) ;
    if MaxGapAll<MaxGap then begin MaxGapAll := MaxGap ; MGX := X end ;
    end {X} ;
  Writeln(F, ^M^J^M^J'Check: ', Q, ' years found, overall Max Gap ',
    MaxGapAll, ' years - ', MonthS[MGX div 31], LZ(Succ(MGX mod 31)):3) ;


  Write(F, ^M^J^M^J^M^J^M^J' Date  Histogram') ; Q := 0 ;
  for X := 114 to 148 { alter if Aleppo prevails } do begin
    Mo := X div 31 ; Dy := Succ(X mod 31) ;
    Write(F, ^M^J, MonthS[Mo], LZ(Dy):3, #32) ;
    for Yr := Y1 to Y2 do begin EProc(Yr, M, D) ;
      if (D=Dy) and (M=Mo) then begin Write(F, ':') ; Inc(Q) end {match} ;
      end {Yr} ;
    end {X} ;
  Writeln(F, ^M^J^M^J'Check: ', Q, ' years found.', ^M^J, '----':35) ;

  Close(F) ;
  end {PaschTable} ;


procedure PaschTest(const N, S : string ; EProc : EProcT) ;
var LI : longint ; J : integer ; Yr : WrdYear ; M, D : Part ;
begin Val(S, LI, J) ;
  if (J<>0) or (LI<0) or (LI>65535) then
    begin Writeln(' Error'^G) ; EXIT end ;
  Yr := LI ;
  EProc(Yr, M, D) ;
  Writeln('    In ', Yr, '':2, N, ' Easter Sunday is ',
    'Day ', D, ' of Month ', M, ';  ', MonthS[M]:4, #32, LZ(D)) ;
  end {PaschTest} ;


procedure EasterRepeats ;
const PD1 = 3*32+22 ; PD2 = 4*32+25 ; Cycle = 5700000 ;
var A : array [PD1..PD2] of record
  LastYr, MaxYear, MaxDiff, MinYear, MinDiff : longint end ;
Histo : array [1..2000] of longint ;
Y, DY : longint ; M, D, X : byte ;
const Y1 = 2000 ; Y2 = Cycle + Y1 - 1 + 100000 ;
begin
  Writeln('First instance of greatest and least intervals in ',
    Y1, ' to ', Y2) ;

  FillChar(Histo, SizeOf(Histo), 0) ;
  for X := PD1 to PD2 do with A[X] do begin LastYr := 0 ;
    MaxYear := 0 ; MaxDiff := 0 ;
    MinYear := 0 ; MinDiff := MaxLongInt end ;

  for Y := Y1 to Y2 do begin if Y mod 1000 = 0 then Write(Y, #13) ;

    LongGregorianEaster(Y, M, D) ; X := M*32+D ;
    if (Y>=0) and (Y<=65535) then begin GregorianEaster(Y, M, D) ;
      if X <> M*32+D then begin Writeln('Long error ', Y) ; More end end ;
    LongGregorianEaster(Y+Cycle, M, D) ;
    if X <> M*32+D then begin Writeln('Repeat error ', Y) ; More end ;

    with A[X] do begin
      if LastYr>0 then begin DY := Y-LastYr ; Inc(Histo[DY]) ;
        if DY>MaxDiff then begin MaxDiff := DY ; MaxYear := LastYr end ;
        if DY<MinDiff then begin MinDiff := DY ; MinYear := LastYr end ;
        end ;
      LastYr := Y ;
      end {A[X]} ;

    end {Y} ;

  Writeln('Date':10, 'From':13,  'Max':8, 'From':12,  'Min':8, ^M^J,
    {}               'Year':23, 'Diff':8, 'Year':12, 'Diff':8) ;
  for X := PD1 to PD2 do begin M := X div 32 ; D := X mod 32 ;
    if D>0 then with A[X] do Writeln(MonthS[M]:8, D:3,
      MaxYear:12, MaxDiff:8, MinYear:12, MinDiff:8) ;
    end ;
  Writeln ;
  Write('  Intervals : ') ;
  for DY := Low(Histo) to High(Histo) do if Histo[DY]>0 then Write(#32, DY) ;
  Writeln ;
  end {EasterRepeats} ;


procedure Hebrew(const Opts : Options) ;
var MJD, D0, D1 : MJDate ; HY : longint ; Yr : IntYear ; M, D : Part ;
begin
  Writeln(' NOTE: Hebrew Days are -0600h to +1800h civil time here.') ;
  repeat
    Write('  Hebrew Year (0 ends) ? ') ; Readln(HY) ;
    if HY<=0 then BREAK ;
    MJD := HYtoMJD(HY) ;
    MJD_to_YMD(Opts, MJD, Yr, M, D) ;
    Write('  A.M. ', HY, ' began on ',
      DateStr(Opts.Astr, Yr, M, D), WkDStr[MJDDayOfWeek(MJD)]) ;
    MJD := HYtoMJD(HY+1) ;
    MJD_to_YMD(Opts, MJD-163, Yr, M, D) ;
    Write(';  Pesach = 15 Nisan = ',
      DateStr(Opts.Astr, Yr, M, D), WkDStr[MJDDayOfWeek(MJD)], '.') ;
    Writeln until false ;

  repeat Write('  MJD (0 ends) ? ') ; Readln(MJD) ;
    HY := MJDtoHY(MJD) ; Writeln('  MJD ', MJD, ' is in A.M. ', HY) ;
    until MJD=0 ;

  Writeln('  MJD 50000-55000 : A.M., MJD span :') ;
  for MJD := 50000 to 55000 do begin Write(MJD:9) ;
    HY := MJDtoHY(MJD) ;
    D0 := HYtoMJD(HY) ; D1 := Pred(HYtoMJD(HY+1)) ;
    Write(HY:9, D0:9, D1:9, '':15, ^M) ;
    if (MJD<D0) or (MJD>D1) then Writeln ;
    end ;
  end {Hebrew} ;


procedure MeanMoon ;
{ For counting Ecclesiastical Full Moons in 5700000 years }
const S = ' : ' ;
var Yr, DY, Count : longint ; M, D, DM, XDM : Part ;
begin while true do begin
    Write('Year Range (0 to stop) ? ') ; ReadLn(DY) ;
    if DY<1 then EXIT ;
    Count := 0 ;
    XDM := 4*31 + 23 { = 2000-04-23 } ;
    for Yr := 2001 to 2000+DY do begin
      if Yr mod 10000 = 0 then Write(Yr:10, ^M) ;
      LongGregorianEaster(Yr, M, D) ;
      DM := M*31 + D ;
      Count := Count + 12 + Ord(DM > XDM) { add 12 or 13 } ;
      XDM := DM ;
      end ;
    Writeln('  Gregorian : ', DY, ' years have ', Count,
      ' lunar months', ^M^J, '  Average ', Count/DY:1:12,
      ' per year, length ', 365.2425*DY/Count:1:12, ' days.') ;
    end ;
  end {MeanMoon} ;


procedure PaschalTests(const Opts : Options)
  { Most Easter algorithms from The Calendar FAQ ;
  Hebrew Years HEBCLNDR.PAS } ;
const CalNamE : array [0..1] of string [9] = ('Julian', 'Gregorian') ;
var EProc : EProcT ; B, X : byte ; S : string [20] ;
begin Writeln(' PaschalTests :') ;
  repeat
    Write('  Easter : (generally A.D. 0..65535) -',
      '   Julian or Gregorian (0/1) /', ^M^J, '   EastDiff.txt (2)',
      ' / Intervals (3) / Hebrew (4) / MeanMoon (5) / Quit (9) ? ') ;
    if B=9 then BREAK ;
    Readln(B) until B<=5 ;

  case B of

    5 : MeanMoon ;

    4 : Hebrew(Opts) ;

    3 : EasterRepeats ;

    2 : GregJulEasterDiff ;

    0,1 : begin

      Write('':3, CalNamE[B], ' Year (Yr) or range (Y1 Y2) ? ') ;
      Readln(S) ; if S='' then EXIT ;
      X := Pos(#32, S) ;

      if B=0 then Eproc := JulianEaster else Eproc := GregorianEaster ;

      if X=0 then PaschTest(CalNamE[B], S, EProc)
        else PaschTable(CalNamE[B], S, X, EProc) ;
      end ;

    end ;

  Writeln end {PaschalTests} ;


procedure DoY_to_MD(Opts : Options) ;
var DDD, D3 : OrdDate ; M, D : Part ; Y, Yr : IntYear ;
begin Writeln(' DoY_to_MD :') ;
  Write(' Test DDD->M/D, Year..Year+3; Year (0 to end) ? ') ;
  Readln(Y) ; if Y=0 then EXIT ;
  for Yr := Y to Y+3 do Write(Yr:12, '':5) ; Writeln ;
  for DDD := 1 to 366 do begin
    for Yr := Y to Y+3 do begin
      DateOfDayNo(Opts, DDD, Yr, M, D) ;
      D3 := DayOfYear(Opts, Yr, M, D) ;
      if D<32 then Write(DDD:6, M:3, '/', D:2, D3:4, ';') else Write(';':17) ;
      if DDD<>D3 then Readln ;
      end ;
    if D=10 then begin Write(' <cr>') ; Readln end else Writeln ;
    end ;
  for Yr := Y to Y+3 do Write(Yr:12, '':5) ; Writeln ;
  Writeln end {DoY_to_MJD} ;


procedure NthXdayTest(const Opts : Options) ;
var N, Mo, Dy : byte ; X : WkDys ; Yr : IntYear ;
{$IFDEF DELPHI} TDT : TDateTime ; q1, q2, q3 : word ; {$ENDIF}
begin Writeln(' NthXdayTest :') ;

  Writeln('  First answer is quicker, second works in J->G year.') ;
  repeat
    Write('  N''th Xday (Sun..Sat=0..6) of Month in Year (N=9 ends) ???? ') ;
    Readln(N, byte(X), Mo, Yr) ;
    if N=9 then BREAK ;
    Write(WkDstr[X]:8) ;

    Dy := NthXdayOfMonth(Opts, Yr, Mo, N, X) ;
    Write(DateStr(Opts.Astr, Yr, Mo, Dy):18) ;
    if Dy=0 then Write('!!!') else Write(Day(Opts, Yr, Mo, Dy)) ;

    Dy := Nth_XdayOfMonth(Opts, Yr, Mo, N, X) ;
    Write(DateStr(Opts.Astr, Yr, Mo, Dy):18) ;
    if Dy=0 then Write('!!!') else Write(Day(Opts, Yr, Mo, Dy)) ;

    {$IFDEF DELPHI}

    TDT := NXDM(N, Ord(X) mod 7 + 1, Mo, Yr) ; DecodeDate(TDT, q1, q2, q3) ;
    Write('   Delphi : ', DateStr(Opts.Astr, q1, q2, q3)) ;

    {$ENDIF DELPHI}

    Writeln until false end {NthXdayTest} ;


procedure CalSheet(const Opts : Options) ;
var Yr : IntYear ; Mo, Dy, DMax : Part ; Wd : WkDys ;
begin Writeln(' CalSheet :') ;
  Writeln('N.B. code may assume that every month has a "1st".') ;
  with Opts do repeat
    Write('Calendar Sheet : ', WrCal(Cal), ': Year, Month (* 0 ends) ?? ') ;
    Readln(Yr, Mo) ;
    if (Yr=0) and not Astr then BREAK ;
    if Mo=0 then BREAK ;
    Write(YearStr(Astr, Yr)) ;
    for Wd := Sun0 to Sat do Write(WkDstr[Wd]:5) ; Writeln ;
    Wd := MJDDayOfWeek(YMD_to_MJD(Opts, Yr, Mo, 1)) ;
    Write(MonthS[Mo], '':(4+5*Ord(Wd))) ;
    DMax := Ulti_Mo(Opts, Yr, Mo) ; Dy := 1 ;
    (* No :
      with ChangeData[ChangeDay] do if (Yr=CY) and (Mo=CMth) and (FirstG>1)
      then Dy := FirstG ;
      *)
    repeat Write(Dy:5) ;
      with ChangeData[ChangeDay] do if (Yr=CY) and (Mo=CMth) and (Dy=LastJ)
        then Dy := FirstG else Inc(Dy) ;
      if Dy>DMax then BREAK ;
      if Wd<Sat then Inc(Wd) else
        begin Wd := Sun0 ; Writeln ; Write('':7) end ;
      until false ;
    Writeln ;
    until false ;
  end {CalSheet} ;



procedure DoMo2(var F : text ; const Yr : IntYear) ;
var Mo : Part ;
begin
  if (Yr mod 10)=0 then Writeln(F) ;
  Write(F, Yr-400:6, Yr:5, Yr+400:5, '':2) ;
  for Mo := 1 to 12 do Write(F, WkDStr[MJDDayOfWeek(YMDtoMJD(Yr, Mo, 1))]:4) ;
  end {DoMo2} ;



procedure GregYears ;
var Job : (Weekly, NoWkly, UKTax, Begins) ;
var F : text ;
MJ : longint ; Yr, Y1, Y2, YY : IntYear ; Mo, Dy, Ult : Part ;
OutName : {$IFDEF PASCAL} PathStr {$ENDIF} {$IFDEF DELPHI} string {$ENDIF} ;
S3 : string [3] ; D1, D4, D7, Dn : WkDys ; M, N : shortint ; X : byte ;


procedure DoMo1(var F : text ; const Yr : IntYear) ;
var Mo, Dy : Part ;
begin
  for Mo := 1 to 12 do begin Write(F, Yr:5, MonthS[Mo]:4) ;

    Ult := Ulti_Mo(GrgCal, Yr, Mo) ;

    case Job of

      NoWkly : begin
        for Dy := 1 to Ult do begin
          if Dy mod 5 = 1 then Write(F, #32) ;

          Dn := MJDDayOfWeek(MJ) { avoid TMT bug } ;
          Write(F, Copy(WkDstr[Dn], 1, 2)) ;

          Inc(MJ) end {Dy} ;
        end {NoWkly} ;

      UKTax : begin
        UKtaxWeekNo(Yr, Mo, 1, YY, N, X) ;
        Write(F, YY:6, '#', LZ(N), '':2) ;
        if X<>1 then Write(F, '':6) ;
        for Dy := 1 to Ult do begin
          UKtaxWeekNo(Yr, Mo, Dy, YY, N, X) ;
          if X=1 then if N=1 then Write(F, ' | ', LZ(Dy), '-')
            else Write(F, LZ(Dy):5, '-') ;
          if (X=7) or ((Mo=4) and (Dy=5)) then Write(F, '-', LZ(Dy)) ;
          end {Dy} ;
        end {UKTax} ;

      Weekly : begin
        if D1=Mon then begin { corrected 2007-02-12 }
          YY := Yr ; ISO_Week_Num(GrgCal, N, YY, Mo, 1) ;
          YY := Yr ; ISO_Week_Num(GrgCal, M, YY, Mo, Ult) ;
          Write(F, '  #', LZ(N), '-#', LZ(M)) end ;

        X := 0 ; Dn := MJDDayOfWeek(MJ) ;
        for Dy := 1 to Ult do begin
          if Dn=D4 then Inc(X) ;
          Dn := WkDys((byte(Dn)+1) mod 7) ;
          end {Dy} ;
        Write(F, '  (', X, ')') ;

        if MJDDayOfWeek(MJ)<>D1 then Write(F, '':5) ;
        for Dy := 1 to Ult do begin
          Dn := MJDDayOfWeek(MJ) ;
          if Dn=D1 then Write(F, LZ(Dy):4, '-') ;
          if Dn=D7 then Write(F, '-', LZ(Dy)) ;
          Inc(MJ) end {Dy} ;
        end {Weekly} ;

      end {case} ;

    Writeln(F) end {Mo} ;
  end {DoMo1} ;

begin Writeln(' GregYears :') ;
  Write('  Output Device / File ? ') ; Readln(OutName) ;
  Assign(F, OutName) ; Rewrite(F) ;

  Write('  Range Y1 Y2 (0 0 exits) ?? ') ;
  Readln(Y1, Y2) ; if Y2<Y1 then Y2 := Y1 ;
  if Y1<=0 then EXIT ;

  repeat byte(D7) := 99 ;
    Write('  Day that Starts a Week (e.g. Mon),'^M^J,
      '   or IR for UK Tax, or B for Begins, or <empty> for non-week ? ') ;
    Readln(S3) ;
    if S3='' then begin Job := NoWkly ; BREAK end ;
    S3[1] := UpCase(S3[1]) ;
    if S3[1]='I' then begin Job := UKTax ; BREAK end ;
    if S3[1]='B' then begin Job := Begins ; BREAK end ;
    for D1 := Sun0 to Sun7 do if S3=WkDstr[D1] then begin
      D7 := WkDys((byte(D1)+6) mod 7) ;
      D4 := WkDys((byte(D1)+3) mod 7) ;
      Job := Weekly ; BREAK end ;
    until D7<=Sat ;

  MJ := YMDtoMJD(Y1, 1, 1) ;
  Write(F, ^M^J,
    'MJD_DATE.PAS  -  Gregorian Calendar for A.D. ':56, Y1) ;
  if Y2<>Y1 then Write(F, -Y2) ;
  Writeln(F, ^M^J) ;

  case Job of
    NoWkly: begin Write(F, ' Year Mo  Days ...'^M^J, '':9) ;
      for Dy := 1 to 6 do Write(F, Dy*5:11) ;
      end ;
    UKTax : Write(F, ' Calendar  Revenue', ^M^J, ' Year Mo   Year Wk') ;

    Begins : begin
      Write(F, 'Gregorian':14, 'First Day of each Month':40,
       ^M^J'       Years      ') ;
      for Mo := 1 to 12 do Write(F, MonthS[Mo]:4) ;
      end ;
    Weekly : begin Write(F, ' Year Mth') ;
      if D1=Mon then Write(F, '  ISO Wks') ;
      Write(F, '  WiM', '':11, 'Weeks ', WkDstr[D1], '--', WkDstr[D7]) ;
      end ;
    end ;
  Writeln(F) ;


  for Yr := Y1 to Y2 do begin if OutName>'' then Write(Yr:5, #13) ;

    if Job=Begins then DoMo2(F, Yr) else DoMo1(F, Yr) ;

    if Job=UKTax then Writeln(F,
      ^M^J'   In the current Tax Year, weeks start on ',
      WkDstr[MJDDayOfWeek(YMDtoMJD(YY, 4, 6))] ) ;

    Writeln(F) end {Yr} ;

  Writeln(F, '------':40) ; Close(F) ;
  end {GregYears} ;


procedure WeeksInYear ;
var Y, Z : IntYear ; var N : TWeekNo ;
const S = '  Year  ISOweekCount  ISOweek_Count  WkNo of 1JanY+1  53' ;
begin Writeln(S) ;
  for Y := 2000 to 2040 do begin
    Write(Y:6, PC_ISOweekCount(Y):14, PC_ISOweek_Count(Y):15) ;
    Z := Y+1 ; ISO_Week_Num(GrgCal, N, Z, 1, 1) ; Write(N:17) ;
    if N=53 then Write('   *') ;
    Writeln ;
    if Y=2020 then begin More ; Writeln(S) end ;
    end ;
  end {WeeksInYear} ;


procedure TryUKtaxCal ;
var Yr, YN : IntYear ; Mo, Dy, DN : Part ; MN, WN : TWeekNo ;
begin
  Writeln('  Under-Tested; rules as believed end Nov 2000 ex WL.') ;
  repeat Write('  Y M D (0 0 0 exits) ??? ') ; Readln(Yr, Mo, Dy) ;
    if Yr=0 then BREAK ;
    UKTaxWeekNo(Yr, Mo, Dy, YN, WN, DN) ;
    Writeln('UK Tax Year ':49, YN, ', week ', WN, ', day ', DN) ;
    UKTaxMonthDay(Yr, Mo, Dy, YN, MN, DN) ;
    Writeln('UK Tax Year ':49, YN, ', month ', MN, ', Day ', DN) ;
    until false ;
  end {TryUKtaxCal} ;


procedure WeekNumberTests(const Opts : Options) ;
var Ch : char ;
begin repeat Write(
      '  CalChange, Date to GenWkNo, GenWkNo (long), Help,',
      ' ISO WkNo of Date, List,'^M^J,
      '   RevenueChk, Start of Week Number, Test,',
      ' WeeksInYear, UKtaxCal, OK ? ') ;
    Readln(Ch) ;
    case UpCase(Ch) of
      'C' : WN_JG_Yr ;
      'D' : Gen_WeekNumTest(Opts) ;
      'G' : TestWeekNumGeneral(Opts) ;
      'H' : Writeln(
        '  C : Week Numbers at Juln->Greg change'^M^J,
        '  D : A Gen', ' Week Number test (YMD->YW)'^M^J,
        '  G : Long Gen', ' Week Number test (YMD->YW)'^M^J,
        '  I : ISO', ' Week Number test (YMD->YW)'^M^J,
        '  L : List Gregorian variously for year range'^M^J,
        '  R : RevenueChk - loop UK tax date tests'^M^J,
        '  S : Gen/ISO YW->YMD of start'^M^J,
        '  T : TestWeekNum - very long'^M^J,
        '  U : UK Tax Week Number'^M^J,
        '  W : ISO Weeks in Year'
        ) ;
      'I' : ISO_WeekNumTest(Opts) ;
      'L' : GregYears ;
      'R' : RevenueCheck(5) ;
      'S' : WkNo_Start_Test(Opts) ;
      'T' : TestWeekNum(Opts) ;
      'U' : TryUKtaxCal ;
      'W' : WeeksInYear ;
      'O', 'K' : BREAK ;
      else Writeln('   Not known.') ;
      end {Ch} ;
    until false end {WeekNumberTests} ;


function LSuS(const Yr : IntYear ; const Mo : Part) : string ;
begin LSuS := (* Known that EU DST change months have 31 days *)
    '  0100 GMT Sunday '+MonthS[Mo]+#32+LZ(LastSun(Yr, Mo, 31)) end {LSuS} ;


procedure BritSumTim ;
var Y, Yr : IntYear ;
begin Writeln(' BritSumTim :') ;
  Writeln('  From 1998 BST will be kept from the last Sunday in March') ;
  Writeln('  until the last Sunday in October.  This has been adopted') ;
  Writeln('  as a directive from the European Parliament and will be') ;
  Writeln('  effective from 1998-2001 inclusive.  Since extended to 2006.') ;
  Write(' UK Summer Time, current EU rules, Year..Year+9; Year ? ') ;
  Readln(Y) ;
  for Yr := Y to Y+9 do begin
    Write(Yr:6, ' :', LSuS(Yr, 3), '  to', LSuS(Yr, 10)) ;
    if YearNear(Yr) then Write('03-':7, EUSTon(Yr), '..10-', EUSToff(Yr)) ;
    Writeln end ;
  Writeln(' US DST change 0200 local clock time ;',
    ' start : + 1 Mo - 24 Dy ; end as UK.') ;
  Writeln(' But US rules may be changing/changed.') ;
  end {BritSumTim} ;


procedure DayRepts(const Opts : Options) ;
var Mo, MJD, MJD1, MJD2 : longint ; WD : WkDys ; Y : IntYear ; M, D : Part ;
Tbl : array [1..31, Sun..Sat] of longint ;
TblF29 : array [Sun..Sat] of longint ;
begin Writeln(' DayRepts :') ;
  FillChar(Tbl, SizeOf(Tbl), 0) ; FillChar(TblF29, SizeOf(TblF29), 0) ;
  Writeln('Tabulate Frequency of DayOfMonth / DayOfWeek Combinations') ;
  Write('  First Y, M, D ??? ') ; Readln(Y, M, D) ;
  MJD1 := YMD_TO_MJD(Opts, Y, M, D) ; Mo := 12*Y+M ;
  Write('  Final Y, M, D ??? ') ; Readln(Y, M, D) ;
  MJD2 := YMD_TO_MJD(Opts, Y, M, D) ; Mo := Succ(12*Y+M-Mo) ;
  Write('Inclusive Months ', Mo) ;
  MJD := Succ(MJD2-MJD1) ;
  Writeln(';   Inclusive Daycount ', MJD,
    ' : ', MJD div 7, ' weeks, ', MJD mod 7, ' days.'^M^J) ;
  for MJD := MJD1 to MJD2 do begin
    MJD_to_YMD(Opts, MJD, Y, M, D) ;
    WD := MJDDayOfWeek(MJD) ;
    if (D=29) and (M=2) then Inc(TblF29[WD]) ;
    Inc(Tbl[D, WD]) end ;
  Write('Day of Month ') ;
  for WD := Sun to Sat do Write(WkDstr[WD]:6) ;
  Writeln ;
  for D := 1 to 31 do begin Write(D:9, '':4) ;
    for WD := Sun to Sat do Write(Tbl[D, WD]:6) ;
    Writeln end ;
  Write(^M^J'Feb 29 :'^M^J, '':13) ;
  for WD := Sun to Sat do Write(TblF29[WD]:6) ;
  Writeln(^M^J) end {DayRepts} ;


procedure LeapTest(const Opts : options) ;
var Y, Y1, Y2 : IntYear ; L, G, P : boolean ;
begin Writeln(' LeapTest :') ;
  AskRomanYears(Opts) ;
  repeat Write('  Y1, Y2 (Y2=0 to end) ?? ') ; Readln(Y1, Y2) ;
    Writeln('    Year    Gen   Greg     PC') ;
    for Y := Y1 to Y2 do begin
      if (Y=0) and not Opts.Astr then CONTINUE ;
      Write(Y:8) ;
      L := Leap_Year(Opts, Y) ; Write(L:7) ;
      if Y>4 then begin
        G := Greg_Leap_Year(Y) ; Write(G:7) ;
        if {(Y>1900) and (Y<2100)} YearNear(Y) then begin
          P := PC_Leap_Year(Y) ; Write(P:7) ;
          if P<>G then Write(^G' P<>G'^G) ;
          end ;
        if G<>L then Write(^G' G<>L'^G) ;
        end ;
      Writeln end {Y} ;
    until Y2=0 ;
  end {LeapTest} ;


procedure AwayDay ;
var Yr : IntYear ; M, D, HS : byte ; Wd : WkDys ;
begin Writeln(' AwayDay :') ;
  Writeln(' Enter default holiday date and discover day actually off.') ;
  repeat
    Write('  Sun->Fri:0, Nearest:1, Sat->Mon:2, else exit; Y M D : #??? ') ;
    Readln(HS, Yr, M, D) ; if HS>2 then EXIT ;
    Wd := MJDDayOfWeek(YMDtoMJD(Yr, M, D)) ;
    MakeDayOff(Yr, M, D, HolShift(HS)) ;
    Writeln('date is ':35, WkDstr[Wd], ', holiday on',
      Yr:5, M:3, D:3, WkDstr[MJDDayOfWeek(YMDtoMJD(Yr, M, D))]:4) ;
    until false ;
  end {AwayDay} ;



{$IFDEF LOOKUP}

procedure CompareRate ;
var MJD, OH, T0, T1, X, YL, Min, Max : longint ; DDD : OrdDate ;
Y : IntYear ; M, D : Part ;
const T = ' ticks' ;
begin Writeln(' CompareRate :') ;
  X := 0 {D3} ;
  Min := YMDtoMJD(1901, 01, 01) ;
  Max := YMDtoMJD(2099, 12, 31) ;
  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; { no-op } end ;
  T1 := GetTickCount ;
  OH := T1-T0 ;
  Writeln('Overhead'^I, OH:4, ' ---', T) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := YMDtoMJD(Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('YMDtoMJD'^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := GD_MJD(Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('GD_MJD  '^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := PC_YMD2MJD1(Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('YMD2MJD1'^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := PC_YMD2MJD0(Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('YMD2MJD0'^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := YMDtoCJD(Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('YMDtoCJD'^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := YD_to_MJD(GrgCal, Y, 30*M+D) end ;
  T1 := GetTickCount ;
  Writeln('YD_to_MJD'^I, T1-T0:4, T1-T0-OH:4, T, X:11) ;

  Writeln(' ...') ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; MJDtoYMD(MJD, Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('MJDtoYMD'^I, T1-T0:4, T1-T0-OH:4, T) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; CJDtoYMD(MJD+2400001, Y, M, D) end ;
  T1 := GetTickCount ;
  Writeln('CJDtoYMD'^I, T1-T0:4, T1-T0-OH:4, T) ;

  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; MJDtoLongYMD(MJD, YL, M, D) end ;
  T1 := GetTickCount ;
  Writeln('MJDtoLongYMD'^I, T1-T0:4, T1-T0-OH:4, T) ;


  T0 := GetTickCount ;
  for MJD := Min to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; MJD_to_YD(GrgCal, MJD, Y, DDD) end ;
  T1 := GetTickCount ;
  Writeln('MJD_to_YD'^I, T1-T0:4, T1-T0-OH:4, T) ;

  Writeln end {CompareRate} ;

{$ENDIF LOOKUP}



{$IFDEF DELPHI}

procedure CompareDelphiRate ;
var MJD, T, X : longint ; Y : IntYear ; M, D : Part ;
YY, MM, DD : word ; XX : TDateTime ;
const Max = 1000000 ;
begin Writeln(' CompareDelphiRate :') ;
  T := GetTickCount ;
  for MJD := 0 to Max do begin
    MJDtoYMD(MJD, Y, M, D) ; X := YMDtoMJD(Y, M, D) ;
    end ;
  Writeln('Dateprox ', GetTickCount-T, ' ms', X:11) ;
  T := GetTickCount ;
  for MJD := 0 to Max do begin
    DecodeDate(MJD, YY, MM, DD) ; XX := EncodeDate(YY, MM, DD) ;
    end ;
  Writeln('Delphi   ', GetTickCount-T, ' ms', XX:18:6) ;
  end {CompareDelphiRate} ;

{$ENDIF DELPHI}


procedure England ;
const JDs : array [0..39] of longint = (
  2341983, 2342031, 2342032, 2342042, 2342043,
  2342349, 2342407, 2342408, 2359515, 2359573,
  2359574, 2359575, 2359598, 2359599, 2359881,
  2360246, 2360610, 2360611, 2360693, 2360694,
  2360701, 2360975, 2360976, 2361024, 2361025,
  2361034, 2361035, 2361036, 2361220, 2361221,
  2361222, 2361331, 2378497, 2400001, 2415021,
  2415079, 2415080, 2415386, 2450001, 2451545 ) ;
var JDN, MJD : longint ; Y : IntYear ; J, M, D : byte ;
GregS, JulnS, EnglS : string [13] ;
Opts : Options ;
begin Writeln(' England :') ;
  Writeln(^M^J,
    '  See http://www.merlyn.demon.co.uk/miscdate.htm'^M^J,
    '  Julian Day No. is that for mid-day : MJD := JDN - 2400001'^M^J,
    '  Authorities differ re Scottish dates'^M^J^M^J,
    '      Julian   Modified    Gregorian      Julian date    Civil date'^M^J,
    '      Day No.  Jul.Date    date           Scotland       England '^M^J) ;
  Opts.Astr := True ;
  with Opts do for J := Low(JDs) to High(JDs) do begin
    JDN := JDs[J] ;
    MJD := JDN - 2400001 ;
    Write(WkDstr[MJDDayOfWeek(MJD)]:4, JDN:9, MJD:9) ;
    Cal := Gregorian ;
    MJD_to_YMD(Opts, MJD, Y, M, D) ;
    GregS := DateStr(Astr, Y, M, D) ;
    Cal := Civil ;
    MJD_to_YMD(Opts, MJD, Y, M, D) ;
    JulnS := DateStr(Astr, Y, M, D) ;
    if (Y<1752) and (M*32+D<3*32+25) then Dec(Y) ;
    EnglS := DateStr(Astr, Y, M, D) ;
    Write(GregS:15) ;
    if JulnS<>GregS then Write(JulnS:15) else Write('as Gregorian':15) ;
    if EnglS<>GregS then Write(EnglS:15) else Write('as Gregorian':15) ;
    Writeln end ;
  Writeln('------':37) ;
  end {England} ;


procedure TestSeasons ;
var M, D : Part ; S : Seasons ;
begin Writeln(' TestSeasons :') ;
  Writeln('  Seasons assumed to start Mar/Jun/Sep/Dec/21st') ;
  repeat
    Write('  Month (>0), Day ?? ') ; Readln(M, D) ;
    if M=0 then BREAK ;
    S :=Season21(M, D) ;
    Writeln(LZ(D):28, MonthS[M]:4,
      'N '+SeasName[S]:11, 'S '+SeasName[OZ(S)]:11) ;
    until false end {TestSeasons} ;


procedure TestAnyYMD ;
var IY, IM, ID : integer ; M, D : Part ;
begin Writeln(' TestAnyYMD :') ;
  repeat
    Write('  Year (<>0), Month, Day ??? ') ; Readln(IY, IM, ID) ;
    if IY=0 then BREAK ;
    MJDtoYMD(AnyYMDtoMJD(IY, IM, ID), IY, M, D) ;
    Writeln(IY:6, M:3, D:3) ;
    until false end {TestAnyYMD} ;


procedure AbsoluteWeekTest ;
var Y : IntYear ; M, D : Part ; Q : longint ; R : Part ;
begin Writeln(' AbsoluteWeekTest :') ;
  Writeln('  ISO Weeks Mon..Sun from Mon 0001-01-01 = Week 1 Day 1') ;
  repeat Write('   Greg Year (>0), Month, Day ??? ') ; Readln(Y, M, D) ;
    if Y<=0 then BREAK ;
    MJDtoAbsWeek(YMDtoMJD(Y, M, D), Q, R) ;
    Writeln('    Week ', Q, ', Day ', R) ;
    until false ;
  end {AbsoluteWeekTest} ;


procedure BusinessDaysTest ;
var MJD1, MJD2, MJD3 : MJDate ; WeekDays, WorkDays : longint ;
Y1, Y2 : IntYear ; M1, M2, D1, D2 : Part ; BV1, BV2, Safe : boolean ;
const HolsList : PHolsList = NIL ; EQ : array [boolean] of char = '= ' ;
begin Writeln(' BusinessDaysTest :') ;
  Writeln('  Business Days between dates - this is, as yet, not optimised.',
    '  UNDERTESTED!') ;
  Writeln('   *** WorkDaysAfter is not right ***') ;
  if HolsList=NIL then ReadDaysOffFile(HolsList) ;
  Write('   Exclude First and/or Second Dates in count (0/1 0/1) ?? ') ;
  Readln(byte(BV1), byte(BV2)) ;
  repeat
    Write('   First Date  Y M D (Y>0) ??? ') ; Readln(Y1, M1, D1) ;
    if Y1<=0 then BREAK ;
    Write('   Second Date Y M D       ??? ') ; Readln(Y2, M2, D2) ;
    MJD1 := YMDtoMJD(Y1, M1, D1) ;
    Write('>':6, EQ[BV1], #32,
      MJDateStr(GrgCal, MJD1), WkDstr[MJDDayOfWeek(MJD1)]) ;
    MJD2 := YMDtoMJD(Y2, M2, D2) ;
    Write('<':6, EQ[BV2], #32,
      MJDateStr(GrgCal, MJD2), WkDstr[MJDDayOfWeek(MJD2)]) ;
    Writeln ;

    WorkDaysOnwards
      (HolsList, MJD1, MJD2, BV1, BV2, WeekDays, WorkDays, Safe) ;
    Write('Slow: WorkDaysOnwards: WeekDays ':24, WeekDays,
      '; Work Days ', WorkDays) ;
    Writeln ;

    WorkDaysFromTo
      (HolsList, MJD1, MJD2, BV1, BV2, WeekDays, WorkDays, Safe) ;
    Write('Fast: WorkDaysFromTo:  WeekDays ':24, WeekDays,
      '; Work Days ', WorkDays) ;
    if not Safe then Write('; Table span uncertain!'^G) ;
    Writeln ;

    WorkDaysFrom(HolsList, MJD1, BV1, WorkDays, MJD3, Safe) ;
    Writeln('Slow  MJD1 ', MJD1, Safe:6, '  MJD2 ', MJD2, ' ?=? MJD3 ', MJD3,
      '':2, MJDateStr(GrgCal, MJD3), WkDstr[MJDDayOfWeek(MJD3)],
      MJD2=MJD3:7) ;

    WorkDaysAfter(HolsList, MJD1, BV1, WorkDays, MJD3, Safe) ;
    Writeln('Fast  MJD1 ', MJD1, Safe:6, '  MJD2 ', MJD2, ' ?=? MJD3 ', MJD3,
      '':2, MJDateStr(GrgCal, MJD3), WkDstr[MJDDayOfWeek(MJD3)],
      MJD2=MJD3:7) ;

    until false ;
  end {BusinessDaysTest} ;


procedure TypeOfDay ;
var MJD : MJDate ; Y : IntYear ; M, D : Part ;
const HolsList : PHolsList = NIL ;
begin Writeln(' TypeOfDay :') ;

  if HolsList=NIL then ReadDaysOffFile(HolsList) ;
  repeat
    Write('   YMD (Y>0) ??? ') ; Readln(Y, M, D) ;
    if Y<=0 then BREAK ;
    MJD := YMDtoMJD(Y, M, D) ;
    Writeln('  MJD ':7, MJD,
      '   Weekday', IsWeekDay(MJD):6,
      '   Holiday', IsHoliday(HolsList, MJD):6,
      '   WorkDay', IsWorkDay(HolsList, MJD):6,
      '':2, MJDateStr(GrgCal, MJD)) ;

    until false ;
  end {TypeOfDay} ;


procedure AnnualWeekAverage ;
const N = 5 ; N400 = N*400 ; First = 1800 ; Last = First + Pred(N400) ;
var WL : array [52..53] of word ;
TotW, T, R : longint ; Y, YN : IntYear ; WN : TWeekNo ; D, DN : Part ;
B : boolean ;
begin Writeln(' Check week lengths, ', First, -Last) ;
  FillChar(WL, SizeOf(WL), 0) ;
  TotW := 0 ;
  for Y := First to Last do begin Write(Y:7, #13) ; D := 32 ;
    repeat Dec(D) ;
      ISO_Week_Num_Day(GrgCal, Y, 12, D, YN, WN, DN) until WN>1 ;
    Inc(TotW, WN) ; Inc(WL[WN]) ;
    end ;
  T := TotW div N ; R := TotW mod N ;
  B := (T=20871) and (R=0) ;
  Writeln('  Total ISO weeks per 400 years ', T, ' remainder ', R, B:7) ;
  Writeln('  Weeks in Year per 400 years -',
    '   52 : ', WL[52]/N:1:1,
    '   53 : ', WL[53]/N:1:1) ;
  end {AnnualWeekAverage} ;


procedure FullMJDtests ;
var X, MJD : MJDate ;
YL : longint ; Y0, Y1 : IntYear ; DDD : OrdDate ; M0, M1, D0, D1 : Part ;
procedure OW(const S : string) ;
{} begin Write(S, MJD:12, Y0:8, M0:3, D0:3) ; Readln ; HALT end {OW} ;
begin

  Writeln('Gregorian 1858-2269') ;
  for MJD := 0 to 150000 do begin MJD_to_YMD(GrgCal, MJD, Y0, M0, D0) ;

    MJDtoYMD(MJD, Y1, M1, D1) ;
    if (Y0<>Y1) or (M0<>M1) or (D0<>D1) then OW('MJD_to_YMD or MJDtoYMD') ;
    MJDtoLongYMD(MJD, YL, M1, D1) ;
    if (Y0<>YL) or (M0<>M1) or (D0<>D1) then OW('MJDtoLongYMD') ;

    CJDtoYMD(MJD+2400001, Y1, M1, D1) ;
    if (Y0<>Y1) or (M0<>M1) or (D0<>D1) then OW('CJDtoYMD') ;

    X := YMD_to_MJD(GrgCal, Y0, M0, D0) ;
    if X<>MJD then OW('YMD_to_MJD') ;

    X := YMDtoMJD(Y0, M0, D0) ;
    if X<>MJD then OW('YMDtoMJD') ;

    X := GD_MJD(Y0, M0, D0) ;
    if X<>MJD then OW('GD_MJD') ;

    X := LongYMDtoMJD(Y0, M0, D0) ;
    if X<>MJD then OW('LongYMDtoMJD') ;

    X := LongYMD_to_MJD(GrgCal, Y0, M0, D0) ;
    if X<>MJD then OW('LongYMD_to_MJD') ;

    {$IFDEF LOOKUP}

    if (Y0>=Low(NearYear)) and (Y0<=High(NearYear)) then begin
      X := PC_YMD2MJD0(Y0, M0, D0) ;
      if X<>MJD then OW('YMD2MJD0') ;
      X := PC_YMD2MJD1(Y0, M0, D0) ;
      if X<>MJD then OW('YMD2MJD1') ;
      X := JPC_MJD(Y0, M0, D0) ;
      if X<>MJD then OW('JPC_MJD') ;
      end ;

    {$ENDIF LOOKUP}

    X := YMDtoCJD(Y0, M0, D0)-2400001 ;
    if X<>MJD then OW('YMDtoCJD') ;

    X := ChrJulDate(Y0, M0, D0)-2400001 ;
    if X<>MJD then OW('ChrJulDate') ;

    if MJD mod 300 = 0 then Write(DateStr(false, Y0, M0, D0), ^M) ;
    end ;
  Writeln ;

  Writeln('Julian 1995-2001') ;
  for MJD := 50000 to 52000 do begin
    MJD_to_YMD(JulCal, MJD, Y0, M0, D0) ;
    X := YMD_to_MJD(JulCal, Y0, M0, D0) ;
    if X<>MJD then OW('YMD_to_MJD') ;
    X := LongYMD_to_MJD(JulCal, Y0, M0, D0) ;
    if X<>MJD then OW('LongYMD_to_MJD') ;
    if MJD mod 100 = 0 then Write(DateStr(false, Y0, M0, D0), ^M) ;
    end ;
  Writeln ;

  Writeln('YYYY-DDD 1858-2269') ;
  for MJD := 0 to 150000 do begin
    MJD_to_YD(GrgCal, MJD, Y0, DDD) ;
    X := YD_to_MJD(GrgCal, Y0, DDD) ;
    if X<>MJD then OW('YD_to_MJD or MJD_to_YD') ;
    if MJD mod 150 = 0 then Write(JDateStr(false, Y0, DDD), ^M) ;
    end ;
  Writeln ;

  end {FullMJDtests} ;


procedure LotOfTests(const Opts : Options) ;
begin
  Writeln(' LotOfTests : This will accumulate hands-free tests.') ;
  FullMJDtests ;
  AnnualWeekAverage ;
  TestISOWN(GrgCal) ;
  ISOcheck(28) ;
  RevenueCheck(28) ;
  end {LotOfTests} ;


procedure Setting(var Opts : Options ; var IBMjln, Swop : boolean) ;
var C : char ; B : byte ;
begin with Opts do begin
    repeat
      Write(' Current : Calendar=', WrCal(Cal),
        '  Astro=', Astr, '  IBMjln=', IBMjln, '  Swop=', Swop, ^M^J,
        ' Change Preset (Civl, Greg, Juln, Astro, IBMjln, Swop,',
        {$IFNDEF WINDOWS}{$IFNDEF NOCRT} ' Font,', {$ENDIF}{$ENDIF}
        ' Help, OK) ? ') ;
      Readln(C) ;
      case UpCase(C) of
        'A' : Astr := not Astr ;
        'C' : begin Cal := Civil ;
          repeat
            Write(' Country Type (British, Romish, Finnish, Other) ? ') ;
            Readln(C) ; B := Pos(UpCase(C), BRFO) until B>0 ;
          ChangeDay := ChangeDate(Pred(B)) ;
          if ChangeDay=Other then repeat
            Write('  Last Julian MJD ? ') ;
            {$I-} Readln(LastJulianMJD[Other]) {$I+} until IOResult=0 ;
          InitialiseDates end ;
        {$IFNDEF WINDOWS}{$IFNDEF NoCrt}
        'F' : TextMode(LastMode xor Font8x8) ; {$ENDIF}{$ENDIF}
        'G' : Cal := Gregorian ;
        'H', '?' : Writeln('  Font toggles lines/screen;'^M^J,
          '  Civl, Greg, Juln select calendars;'^M^J,
          '  IBMjln will flip between',
          ' Y'+DateSep+'M'+DateSep+'D & Y'+JulnSep+'D;'^M^J,
          '  Swop flips between read [+-]MJD and read',
          ' [+-]Y'+DateSep+'M'+DateSep+'D or [+-]Y'+JulnSep+'D.') ;
        'I' : IBMjln := not IBMjln ;
        'J' : Cal := Julian ;
        'O', 'K' : EXIT ;
        'S' : Swop := not Swop ;
        else Writeln(' Setting Error!'^G) ;
        end {case} ;
      until false ;
    end end {Setting} ;


procedure OddTests(const Opts : Options) ;
var C : char ;
begin repeat
    Write(' AwayDay, BST, Cal, DoY, England, FloatJD,',
      ' GregYears, Help, IncDate,',
      {$IFDEF JDtest} ' JDs,', {$ENDIF}
      ' Leap,'^M^J'   Mar1, Paschal, Quick, Repts, Sec, Till,',
      ' Valid, X(yd-ymd), YearMatch,'^M^J'   #, OK ? ') ;
    Readln(C) ;
    case UpCase(C) of
      'A' : AwayDay ;
      'B' : BritSumTim ;
      'C' : CalSheet(Opts) ;
      'D' : DayOfYearTest(Opts) ;
      'E' : England ;
      'F' : FloatJD(Opts) ;
      'G' : GregYears ;
      'H', '?' : Write(
        '  AwayDay tests shift of holiday from weekend;'^M^J,
        '  BST lists UK/EU Summer Time on/off;'^M^J,
        '  Cal gives month calendar sheets;'^M^J,
        '  DoY tests DayOfYr;'^M^J,
        '  England compares Greg, Juln, Civil for a list of JDs;'^M^J,
        '  Float-JD to/from Y M D;'^M^J,
        '  GregYears compact list for year-range, Week Nos or plain;'^M^J,
        '  IncDate takes Y M D and adds By;'^M^J,
        {$IFDEF JDtest}
        '  JDs uses Shadow''s data in JUL_DATE.PAS;'^M^J, {$ENDIF}
        '  Leap tests Leap Years;'^M^J,
        '  Mar1 does 1 Mar 1980-2020;'^M^J,
        '  Paschal does Easter;'^M^J,
        '  Quick: CompareRate, CompareDelphiRate;'^M^J,
        '  Repts lists DoW/DoM frequency;'^M^J,
        '  Sec tests Secs convert;'^M^J,
        '  Till subtracts dates;'^M^J,
        '  Valid tests validity of Y M D dates;'^M^J,
        '  X does DoY to MD;'^M^J,
        '  YearMatch seeks previous 12-month matches;'^M^J,
        '  0 tests YrMoNorm;'^M^J,
        '  4 tests Seasons;'^M^J,
        '') ;
      'I' : IncDateTest(Opts) ;
      {$IFDEF JDtest} 'J' : JDtest {Greg} ; {$ENDIF}
      'L' : LeapTest(Opts) ;
      'M' : Mar1List(Opts) ;
      'O', 'K' : EXIT ;
      'P' : PaschalTests(Opts) ;
      'Q' : begin Writeln('  Wait..') ;
        {$IFDEF LOOKUP} CompareRate ; {$ENDIF}
        {$IFDEF DELPHI} CompareDelphiRate ; {$ENDIF}
        end ;
      'R' : DayRepts(Opts) ;
      'S' : SecondsTest ;
      'T' : TillTest(Opts) ;
      'V' : ValidTest(Opts) ;
      'X' : DoY_to_MD(Opts) ;
      'Y' : YearMatches ;
      '0' : TestAnyYMD ;
      '4' : TestSeasons ;
      else Writeln(' Selection Error!'^G) ;
      end {case} ;
    until false ;
  end {OddTests} ;


procedure DaysOfWeekTests ;
var MJD, MJD1, MJD2 : MJDate ; Y : IntYear ; T : longint ;
M, D, B1, B2, B3, B4, B5 : Part ; X1, X2 : Wkdys ;
const OneSec = {$IFDEF DELPHI} 1000 {$ELSE} 18 {$ENDIF} ;
begin Writeln(' DaysOfWeekTests :') ;

  Writeln('  Method        Speed (conversions/sec)') ;

  MJD := 0 ; T := SynchTickCount ;
  repeat X1 := MJDDayOfWeek(MJD) ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  MJDDayOfWeek ', MJD:9) ;

  MJD := 0 ; T := SynchTickCount ;
  repeat B2 := ISODoW1(MJD) ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  ISODoW1 ', MJD:11) ;

  Writeln ;

  MJD := 0 ; T := SynchTickCount ;
  repeat X2 := Zeller(1999, 9, 9) ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  Zeller ', MJD:12) ;

  MJD := 0 ; T := SynchTickCount ;
  repeat B3 := EchtZeller(Gregorian, 1999, 9, 9) ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  EchtZeller ', MJD:8) ;

  MJD := 0 ; T := SynchTickCount ;
  repeat B4 := (ZelCMJD(1999, 9, 9) + 2) mod 7 + 1 ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  By ZelCMJD ', MJD:8) ;

  MJD := 0 ; T := SynchTickCount ;
  repeat B5 := Zel_Dow(1999, 9, 9) + 1 ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  By Zel_DoW ', MJD:8) ;

  MJD := 0 ; T := SynchTickCount ;
  repeat B1 := SvenDOW(1999, 9, 9) ;
    Inc(MJD) until GetTickCount > T+OneSec ;
  Writeln('  SvenDOW ', MJD:11) ;

  {$IFDEF DELPHI}
  if (Ord(X1)+Ord(X2)+B1+B2+B3+B4+B5)<0 then HALT(99) ;
  {$ENDIF merely to avoid unwanted compiler warnings}

  Writeln('  Note : speed is much affected by compiler and types used.') ;

  Write('  Test MJD range = ? ? ') { Gregorian } ; Readln(MJD1, MJD2) ;
  for MJD := MJD1 to MJD2 do begin Write(MJD:9) ;
    MJDtoYMD(MJD, Y, M, D) ;
    Write(Y:6, M:3, D:3, '':2) ;
    X1 := MJDDayOfWeek(MJD) ;
    Write(Ord(X1):2) ;

    Write('':2) ;

    X2 := Zeller(Y, M, D) ;
    Write(Ord(X2):2) ; if X2<>X1 then Readln ;

    B2 := EchtZeller(Gregorian, Y, M, D) ;
    Write(B2:2) ; if B2 mod 7<>Ord(X1) then Readln ;

    B2 := (ZelCMJD(Y, M, D) + 2) mod 7 + 1 ;
    Write(B2:2) ; if B2 mod 7<>Ord(X1) then Readln ;

    B2 := Zel_DoW(Y, M, D) + 1 ;
    Write(B2:2) ; if B2 mod 7<>Ord(X1) then Readln ;

    B1 := SvenDow(Y, M, D) ;
    Write(B1:2) ; if B1 mod 7<>Ord(X1) then Readln ;

    B2 := ISODoW1(MJD) ;
    Write(B2:2) ; if B2 mod 7<>Ord(X1) then Readln ;

    Write(#13, '':37, #13) end {MJD} ;

  Writeln end {DaysOfWeekTests} ;


procedure WeekTests(const Opts : Options) ;
var C : char ;
begin repeat
    Write(' AbsoluteWeek, BusinessDays, DaysOfWeekTests, FirstThursTests,',
      ^M^J'  Help, NthXday, TypeOfDay, WkNoTests, OK ? ') ;
    Readln(C) ;
    case UpCase(C) of
      'A' : AbsoluteWeekTest ;
      'B' : BusinessDaysTest ;
      'D' : DaysOfWeekTests ;
      'F' : FirstThursTests(Opts) ;
      'H', '?' : Write(
        '  AbsWeek converts YMD to WD from 0001-01-01 Mon;'^M^J,
        '  BusinessDays counts Business Days from Date to Date;'^M^J,
        '  DaysOfWeekTests tests code giving 0..6, 1..7, Mon..Sun. etc.'^M^J,
        '  FirstThursTests tests FirstThursdays;'^M^J,
        '  NthXday does the N''th X-day of .. '^M^J,
        '  TypeOfDay is connected with Working Days'^M^J,
        '  WkNoTests menu tests Week Number;'^M^J,
        '') ;
      'N' : NthXdayTest(Opts) ;
      'O', 'K' : BREAK ;
      'T' : TypeOfDay ;
      'W' : WeekNumberTests(Opts) ;
      else Writeln(' Selection Error!'^G) ;
      end {case} ;
    until false ;
  end {WeekTests} ;


procedure Help ;
begin
  Writeln(
    'MJD_DATE YYYY MM DD -> MJD'^M^J,
    'MJD_DATE MJD -> YYYY MM DD'^M^J,
    'MJD_DATE -> prompts ...') ;
  end {Help} ;


procedure UserTesting ;
type CalcProc = procedure (Opts : Options ; IBMj : boolean ; St : string) ;
const Prox : array [boolean] of CalcProc = (CalcNum, CalcStr) ;
Opts : Options = (Cal:Civil; Astr:false) ;
IBMjln : boolean = false ;
Swop : boolean = false ;
var S : string ; C : char ;
begin repeat
    if Swop then
      if IBMjln then Write('Y'+JulnSep+'D')
      else Write('Y'+DateSep+'M'+DateSep+'D')
      else Write('MJDay') ;
    Write(' (<DATE>, Help, Input, Lots, OddTests,') ;
    if not Swop then Write(' Rand, Try,') ;
    Write(' Setup, Weeks, Quit) ? ') ;
    Readln(S) ; if S='' then S := '?' ; C := UpCase(S[1]) ;
    if Swop then if C in ['R', 'T'] then C := #0 ;
    case C of
      'H', '?' : begin Help ;
        Writeln(' Enter Date in indicated form, or :'^M^J,
          ' Rand uses a random MJD, Try uses a preselected MJD set;'^M^J,
          ' Input Y/M/D or Y-D test; OddTests; WeekTests;'^M^J,
          ' Lots = multiple tests; Setup alters conditions.') end ;
      'I' : InTest(Opts.Astr, IBMjln) ;
      'L' : LotOfTests(Opts) ;
      'O' : OddTests(Opts) ;
      'Q' : EXIT ;
      'R' : Trial(Opts, IBMjln,
        MJDate(Random(42773))*512 + Random(512) - MJDate(30000)*365) ;
      'S' : Setting(Opts, IBMjln, Swop) ;
      'T' : TestSet(Opts, IBMjln) ;
      'W' : WeekTests(Opts) ;
      '0'..'9', '+', '-', 'A', 'B' : Prox[Swop](Opts, IBMjln, S) ;
      else Writeln(' Command Error!'^G) ;
      end {case} ;
    until false ;
  end {UserTesting} ;


procedure TryShort ;
var MJD, Ans : MJDate ; K: integer ; Y : IntYear ; M, D : Part ;
begin
  Write('Testing short routines :'^M^J'   MJD   ->  Date   ->  ',
    'MJD    OK?    JPC    OK?') ;
  {$IFDEF LOOKUP} Write('  Table0   OK?  Table1   OK?') ; {$ENDIF}
  Writeln ;
  for K := -3 to 3 do begin MJD := 50000 + longint(16666)*K ;
    Write(MJD:7) ;
    MJDtoYMD(MJD, Y, M, D) ; Write(Y:7, '-', LZ(M), '-', LZ(D)) ;
    Ans := YMDtoMJD(Y, M, D) ; Write(Ans:8, Ans=MJD:6) ;
    if (Y>1897) and (Y<2100) then begin
      Ans := JPC_MJD(Y, M, D) ; Write(Ans:8, Ans=MJD:6) end ;

    {$IFDEF LOOKUP}
    if {(Y>1900) and (Y<2100)} YearNear(Y) then begin
      Ans := PC_YMD2MJD0(Y, M, D) ; Write(Ans:8, Ans=MJD:6) {end} ;
      { if (Y>1900) and (Y<2100) then begin }
      Ans := PC_YMD2MJD1(Y, M, D) ; Write(Ans:8, Ans=MJD:6) end ;
    {$ENDIF LOOKUP}

    Writeln end {K} ;
  end {TryShort} ;


procedure Today ;
var WY, WM, WD, X : word ;
begin GetNow(WY, WM, WD, X, X, X) ;
  Lairt(CivCal, false, WY, WM, WD) end {Today} ;


function Param(const N : word) : longint ;
var V : longint ; J : integer ;
begin Val(ParamStr(N), V, J) ;
  if J<>0 then begin Writeln(^G'Eh? error at character ', J) ; HALT end ;
  Param := V end {Param} ;



BEGIN ;
if ParamStr(1)='/?' then begin Help ; HALT end ;

if ParamCount>0 then begin
  case ParamCount of
    3 : Lairt(CivCal, false, Param(1), Param(2), Param(3)) ;
    1 : Trial(CivCal, false, Param(1)) ;
    else Help end ;
  HALT ;
  end ;

Writeln(^M^J'Program MJD_DATE.PAS >= 2008'+DateSep+'01'+DateSep+'19',
  '   www.merlyn.demon.co.uk'^M^J, UDP) ;
{$IFDEF PEDT} Write('   Using unit TextSet') ; {$ENDIF}
Writeln('   Compiled with ',
  {$IFDEF __TMT__} 'TMT ', {$ELSE} 'Borland ', {$ENDIF}
  {$IFDEF PASCAL} 'Pascal', {$ENDIF}
  {$IFDEF DELPHI} 'Delphi', {$ENDIF}
  ^M^J'   See http://www.merlyn.demon.co.uk/miscdate.htm etc.',
  ^M^J'   Note : MJD changes at Greenwich midnight; CJD = MJD + 2400001.') ;

TryShort ;
Trial(GrgCal, false,    50000) { Tue 10 Oct 1995 = MJD 50000 } ;
Trial(CivCal, false, -2140743) { Ussher's Creation : Sun 23 Oct 4004 BC } ;
Trial(GrgCal, false,    51544) { 2000/01/01 Greg } ;
Lairt(GrgCal, false,  2000, 1, 1) { ditto } ;
Lairt(GrgCal, false,  1899, 12, 30) { Delphi TDateTime 0.0 } ;
Lairt(JulCal, false, -4713, 1, 1) ; { noon: JDN=0 }
Today ;
More ;
TestSet(CivCal, false) ;
UserTesting ;
Writeln('Done.') ;
END.