program project1;

uses

SysUtils;

const

NUM_RUNS = 200*1000*1000;

type

TLeapYearFunc = function (Year: Word): Boolean;

TMonthDaysFunc = function (const AYear, AMonth: Word): Word;

var

testyears:array[0..NUM_RUNS]of dword;

{ Leap year tests }

function EmptyLeapYear(Year: Word): Boolean;

begin

Result := false;

end;

function IsLeapYear(Year: Word): boolean;

begin

Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));

end;

Function IsLeapYear1(Year:Word):Boolean;

Begin

If Year mod 100<>0 Then

Result:=(Year mod 4)=0

Else

Result:=(Year mod 400)=0;

End;

Function IsLeapYear2(Year:Word):Boolean;

Begin

If Year mod 100<>0 Then

Result:=(Year mod 4)=0

Else

Result:=(Year mod 16)=0;

End;

function LeapYearTest(Func: TLeapYearFunc): TDateTime;

var

i: Integer;

t: TDateTime;

year: Word;

begin

t := Now();

for i := 1 to high(testyears) do

begin

//year := Random(10000);

Func(testyears[i]);

Func(testyears[i]+3);

Func(testyears[i]-1);

end;

Result := Now() - t;

end;

{ Month days tests }

function EmptyMonthDays(const AYear, AMonth: Word): Word;

begin

Result := 30;

end;

Function MonthDaysFPC(const AYear, AMonth: Word): Word;

begin

Result := MonthDays[IsLeapYear(AYear), AMonth];

end;

Function MonthDays1(const AYear, AMonth: Word): Word;

begin

If AMonth=2 Then

If IsLeapYear(AYear) Then

Result:=29

Else

Result:=28

Else

Result:=30 Or (AMonth Xor (AMonth shr 3));

end;

function MonthDaysTest(Func: TMonthDaysFunc): TDateTime;

var

i: Integer;

t: TDateTime;

year: Word;

month: Word;

begin

t := Now();

for i := 1 to NUM_RUNS do

begin

year := Random(10000);

month := Random(12) + 1;

Func(year, month);

end;

Result := Now() - t;

end;

const

FMT = 's.zzz" s"';

var

t0, t1, t2, t3 : TDateTime;

i:integer;

begin

Randomize;

WriteLn('LEAP YEAR TESTS...');

for i:=0 to high(testyears) do testyears[i]:=-2000+random(6000);

t0 := LeapYearTest(@EmptyLeapYear);

t1 := LeapYearTest(@IsLeapYear); // dummy run to optimize caches

t1 := LeapYearTest(@IsLeapYear);

t2 := LeapYearTest(@IsLeapYear1);

t3 := LeapYearTest(@IsLeapYear2);

WriteLn(' Loop only: ', FormatDateTime(FMT, t0));

WriteLn(' FPC: ', FormatDateTime(FMT, t1), ', corrected: ', FormatDateTime(FMT, t1-t0), ' (100%)');

WriteLn(' Variant 1: ', FormatDatetime(FMT, t2), ', corrected: ', FormatDateTime(FMT, t2-t0), ' (', (t2-t0)/(t1-t0)*100:3:0, '%)');

WriteLn(' Variant 2: ', FormatDateTime(FMT, t3), ', corrected: ', FormatDateTime(FMT, t3-t0), ' (', (t3-t0)/(t1-t0)*100:3:0, '%)');

WriteLn;

WriteLn('MONTH DAYS TESTS...');

t0 := MonthDaysTest(@EmptyMonthDays);

t1 := MonthDaysTest(@MonthDaysFPC);

t2 := MonthDaysTest(@MonthDays1);

WriteLn(' Loop only: ', FormatDateTime(FMT, t0));

WriteLn(' FPC: ', FormatDateTime(FMT, t1), ', corrected: ', FormatDateTime(FMT, t1-t0), ' (100%)');

WriteLn(' Variant 1: ', FormatDatetime(FMT, t2), ', corrected: ', FormatDateTime(FMT, t2-t0), ' (', (t2-t0)/(t1-t0)*100:3:0, '%)');

WriteLn;

Write('Test finished. Press ENTER to close...');

ReadLn;

end.