Test suite results for test file webtbs/tw2514.pp

Test run data :

View Test suite results

Test file "webtbs/tw2514.pp" information:

t_id 1184
t_adddate 2003/11/05
t_result 0
t_knownrunerror 0
t_opts -Or

Detailed test run results:

Record count: 50

Total = 50

OK=49 Percentage= 98.00

Source:

{ %opt=-Or }

{ Source provided for Free Pascal Bug Report 2514 }
{ Submitted by "Andreas Horst" on  2003-05-28 }
{ e-mail: AndyHorst@web.de }
{$mode objfpc}
type TRGB=record
 TRGB2HSL: record
 r,g,b : extended;
 l,h,s : extended;
 end;
 end;

 THSL=record end;

function TRGB2HSL(rgb:TRGB):THSL;
var maxcolor,mincolor:Extended;
begin
  with rgb,TRGB2HSL do begin
    if r<0 then r:=0;
    if r>1 then r:=1;
    if g<0 then g:=0;
    if g>1 then g:=1;
    if b<0 then b:=0;
    if b>1 then b:=1;
    if rmaxcolor then
      maxcolor:=b;
    if maxcolor=mincolor then begin
      l:=maxcolor;
      s:=0;
      h:=0;
      Exit;
    end;
    l:=(maxcolor+mincolor)/2;
    if l<0.5 then
      s:=(maxcolor-mincolor)/(maxcolor+mincolor)
    else
      s:=(maxcolor-mincolor)/(2-maxcolor-mincolor);
    if r=maxcolor then h:=(g-b)/(maxcolor-mincolor);
    if g=maxcolor then h:=2+(b-r)/(maxcolor-mincolor);
    if b=maxcolor then h:=4+(r-g)/(maxcolor-mincolor);
  end
end;

var
  rgb : TRGB;
  i : longint;
begin
  fillchar(rgb,sizeof(rgb),0);
  for i:=0 to 100 do
    TRGB2HSL(rgb);
end.

Link to SVN view of webtbs/tw2514.pp source.