Need some test/test's that won't work (correctly) on my
source. Please???!!!...
Ok this is the program:

{wrong answer 2}
var n,i,j,maxi,maxseg,nsg,aux,min:integer;
    seg:array[1..500,1..2] of integer;
    included,selseg:array[1..500] of integer;

    function incl(seg1,seg2:integer):boolean;
    begin
      incl:=(seg[seg1,1]<seg[seg2,1]) and (seg[seg1,2]>seg[seg2,2]);
    end;

begin
  readln(n);
  for i:=1 to n do readln(seg[i,1],seg[i,2]);
  fillchar(included, sizeof(included),0);
  maxi:=0; maxseg:=0;
  for i:=1 to n do
    for j:=1 to n do
      if incl(i,j) then begin
        inc(included[i]);
        if maxi<included[i] then begin
          maxi:=included[i];
          maxseg:=i;
        end;
      end;
  if maxseg>0 then begin
    nsg:=1; selseg[1]:=maxseg;
    for i:=1 to n do
      if incl(maxseg,i) then begin
        inc(nsg);
        selseg[nsg]:=i;
     end;

    for i:=1 to nsg-1 do
      for j:=i+1 to nsg do
        if abs(seg[selseg[i],1]-seg[selseg[i],2])>abs(seg[selseg[j],1]-seg[selseg[j],2]) then begin
          aux:=selseg[i]; selseg[i]:=selseg[j]; selseg[j]:=aux;
        end;
  end else begin
    nsg:=1;
    min:=maxint;
    for i:=1 to n do
      if abs(seg[i,1]-seg[i,2])<min then begin
        min:=abs(seg[i,1]-seg[i,2]);
        selseg[1]:=i;
      end;
  end;
  writeln(nsg);
  for i:=1 to nsg do write(selseg[i],' ');
end.