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.
Recent
