git.oblomov.eu Git - xorg/xrandr/blob - xrandr_test.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 # xrandr Test suite
   5 #
   6 # Do a set of xrandr calls and verify that the screen setup is as expected
   7 # after each call.
   8 #
   9
  10 $xrandr="xrandr";
  11 $xrandr=$ENV{XRANDR} if defined $ENV{XRANDR};
  12 $version="0.1";
  13 $inbetween="";
  14 print "\n***** xrandr test suite V$version *****\n\n";
  15
  16 # Known issues and their fixes
  17 %fixes=(
  18  s2 => "xrandr: 307f3686",
  19  s4 => "xserver: f7dd0c72",
  20  s11 => "xrandr: f7aaf894",
  21  s18 => "issue known, but not fixed yet"
  22 );
  23
  24 # Get output configuration
  25 @outputs=();
  26 %mode_name=();
  27 %out_modes=();
  28 %modes=();
  29 open P, "$xrandr --verbose|" or die "$xrandr";
  30 while (<P>) {
  31   if (/^\S/) {
  32     $o=""; $m=""; $x="";
  33   }
  34   if (/^(\S+)\s(connected|unknown connection)\s/) {
  35     $o=$1;
  36     push @outputs, $o         if $2 eq "connected";
  37     push @outputs_unknown, $o if $2 eq "unknown connection";
  38     $out_modes{$o}=[];
  39   } elsif (/^\s+(\d+x\d+)\s+\((0x[0-9a-f]+)\)/) {
  40     my $m=$1;
  41     my $x=$2;
  42     while (<P>) {
  43       if (/^\s+(\d+x\d+)\s+\((0x[0-9a-f]+)\)/) {
  44         print "WARNING: Ignoring incomplete mode $x:$m on $o\n";
  45         $m=$1, $x=$2;
  46       } elsif (/^\s+v:.*?([0-9.]+)Hz\s*$/) {
  47         if (defined $mode_name{$x} && $mode_name{$x} ne "$m\@$1") {
  48           print "WARNING: Ignoring mode $x:$m\@$1 because $x:$mode_name{$x} already exists\n";
  49           last;
  50         }
  51         if (defined $modes{"$o:$x"}) {
  52           print "WARNING: Ignoring duplicate mode $x on $o\n";
  53           last;
  54         }
  55         $mode_name{$x}="$m\@$1";
  56         push @{$out_modes{$o}}, $x;
  57         $modes{"$o:$x"}=$x;
  58         $modes{"$o:$m\@$1"}=$x;
  59         $modes{"$o:$m"}=$x;
  60         last;
  61       }
  62     }
  63   }
  64 }
  65 close P;
  66 @outputs=(@outputs,@outputs_unknown) if @outputs < 2;
  67
  68 # preamble
  69 if ($ARGV[0] eq "-w") {
  70   print "Waiting for keypress after each test for manual verification.\n\n";
  71   $inbetween='print "    Press <Return> to continue...\n"; $_=<STDIN>';
  72 } elsif ($ARGV[0] ne "") {
  73   print "Preparing for test # $ARGV[0]\n\n";
  74   $prepare = $ARGV[0];
  75 }
  76
  77 print "Detected connected outputs and available modes:\n\n";
  78 for $o (@outputs) {
  79   print "$o:";
  80   my $i=0;
  81   for $x (@{$out_modes{$o}}) {
  82     print "\n" if $i++ % 3 == 0;
  83     print "  $x:$mode_name{$x}";
  84   }
  85   print "\n";
  86 }
  87 print "\n";
  88
  89 if (@outputs < 2) {
  90   print "Found less than two connected outputs. No tests available for that.\n";
  91   exit 1;
  92 }
  93 if (@outputs > 2) {
  94   print "Note: No tests for more than two connected outputs available yet.\n";
  95   print "Using the first two outputs.\n\n";
  96 }
  97
  98 $a=$outputs[0];
  99 $b=$outputs[1];
 100
 101 # For each resolution only a single refresh rate should be used in order to
 102 # reduce ambiguities. For that we need to find unused modes. The %used hash is
 103 # used to track used ones. All references point to <id>.
 104 #   <output>:<id>
 105 #   <output>:<width>x<height>@<refresh>
 106 #   <output>:<width>x<height>
 107 #   <id>
 108 #   <width>x<height>@<refresh>
 109 #   <width>x<height>
 110 %used=();
 111
 112 # Find biggest common mode
 113 undef $sab;
 114 for my $x (@{$out_modes{$a}}) {
 115   if (defined $modes{"$b:$x"}) {
 116     $m=$mode_name{$x};
 117     $sab="$x:$m";
 118     $m =~ m/(\d+x\d+)\@([0-9.]+)/;
 119     $used{$x} = $x;
 120     $used{$1} = $x;
 121     $used{"$a:$x"} = $x;
 122     $used{"$b:$x"} = $x;
 123     $used{"$a:$m"} = $mode_name{$x};
 124     $used{"$b:$m"} = $mode_name{$x};
 125     $used{"$a:$1"} = $x;
 126     $used{"$b:$1"} = $x;
 127     last;
 128   }
 129 }
 130 if (! defined $sab) {
 131   print "Cannot find common mode between $a and $b.\n";
 132   print "Test suite is designed to need a common mode.\n";
 133   exit 1;
 134 }
 135
 136 # Find sets of additional non-common modes
 137 # Try to get non-overlapping resolution set, but if that fails get overlapping
 138 # ones but with different refresh values, if that fails any with nonequal
 139 # timings, and if that fails any one, but warn.
 140 # Try modes unknown to other outputs first, they might need common ones
 141 # themselves.
 142 sub get_mode {
 143   my $o=$_[0];
 144   for my $pass (1, 2, 3, 4, 5, 6, 7, 8, 9) {
 145     CONT: for my $x (@{$out_modes{$o}}) {
 146       $m = $mode_name{$x};
 147       $m =~ m/(\d+x\d+)\@([0-9.]+)/;
 148       next CONT if defined $used{"$o:$x"};
 149       next CONT if $pass < 9 && defined $used{"$o:$m"};
 150       next CONT if $pass < 7 && defined $used{"$o:$1"};
 151       next CONT if $pass < 6 && defined $used{$m};
 152       next CONT if $pass < 4 && defined $used{$1};
 153       for my $other (@outputs) {
 154         next if $other eq $o;
 155         next CONT if $pass < 8 && defined $used{"$o:$x"};
 156         next CONT if $pass < 5 && $used{"$other:$1"};
 157         next CONT if $pass < 3 && $modes{"$other:$m"};
 158         next CONT if $pass < 2 && $modes{"$other:$1"};
 159       }
 160       if ($pass >= 6) {
 161         print "Warning: No more non-common modes, using $m for $o\n";
 162       }
 163       $used{"$o:$x"} = $x;
 164       $used{"$o:$m"} = $x;
 165       $used{"$o:$1"} = $x;
 166       $used{$x} = $x;
 167       $used{$m} = $x;
 168       $used{$1} = $x;
 169       return "$x:$m";
 170     }
 171   }
 172   print "Warning: Cannot find any more modes for $o.\n";
 173   return undef;
 174 }
 175 sub mode_to_randr {
 176   $_[0] =~ m/^(0x[0-9a-f]+):(\d+)x(\d+)\@([0-9.]+)/;
 177   return "--mode $1";
 178 }
 179
 180 $sa1=get_mode($a);
 181 $sa2=get_mode($a);
 182 $sb1=get_mode($b);
 183 $sb2=get_mode($b);
 184
 185 $mab=mode_to_randr($sab);
 186 $ma1=mode_to_randr($sa1);
 187 $ma2=mode_to_randr($sa2);
 188 $mb1=mode_to_randr($sb1);
 189 $mb2=mode_to_randr($sb2);
 190
 191 # Shortcuts
 192 $oa="--output $a";
 193 $ob="--output $b";
 194
 195 # Print config
 196 print "A:  $a (mab,ma1,ma2)\nB:  $b (mab,mb1,mb2)\n\n";
 197 print "mab: $sab\nma1: $sa1\nma2: $sa2\nmb1: $sb1\nmb2: $sb2\n\n";
 198 print "Initial config:\n";
 199 system "$xrandr";
 200 print "\n";
 201
 202 # Test subroutine
 203 sub t {
 204   my $name=$_[0];
 205   my $expect=$_[1];
 206   my $args=$_[2];
 207   print "*** $name:  $args\n";
 208   print "?   $expect\n" if $expect ne "";
 209   if ($name eq $prepare) {
 210     print "->  Prepared to run test\n\nRun test now with\n$xrandr --verbose $args\n\n";
 211     exit 0;
 212   }
 213   my %r   = ();
 214   my $r   = "";
 215   my $out = "";
 216   if (system ("$xrandr --verbose $args") == 0) {
 217     # Determine active configuration
 218     open P, "$xrandr --verbose|" or die "$xrandr";
 219     my ($o, $c, $m, $x);
 220     while (<P>) {
 221       $out.=$_;
 222       if (/^\S/) {
 223         $o=""; $c=""; $m=""; $x="";
 224       }
 225       if (/^(\S+)\s(connected|unknown connection) (\d+x\d+)\+\d+\+\d+\s+\((0x[0-9a-f]+)\)/) {
 226         $o=$1;
 227         $m=$3;
 228         $x=$4;
 229         $o="A" if $o eq $a;
 230         $o="B" if $o eq $b;
 231       } elsif (/^\s*CRTC:\s*(\d)/) {
 232         $c=$1;
 233       } elsif (/^\s+$m\s+\($x\)/) {
 234         while (<P>) {
 235           $out.=$_;
 236           if (/^\s+\d+x\d+\s/) {
 237             $r{$o}="$x:$m\@?($c)" unless defined $r{$o};
 238             # we don't have to reparse this - something is wrong anyway,
 239             # and it probably is no relevant resolution as well
 240             last;
 241           } elsif (/^\s+v:.*?([0-9.]+)Hz\s*$/) {
 242             $r{$o}="$x:$m\@$1($c)";
 243             last;
 244           }
 245         }
 246       }
 247     }
 248     for $o (sort keys %r) {
 249       $r .= "  $o: $r{$o}";
 250     }
 251     close P;
 252   } else {
 253     $expect="success" if $expect="";
 254     $r="failed";
 255   }
 256   # Verify
 257   if ($expect ne "") {
 258     print "->$r\n";
 259     if ($r eq "  $expect") {
 260       print "->  ok\n\n";
 261     } else {
 262       print "\n$out";
 263       print "\n->  FAILED: Test # $name:\n\n";
 264       print "    $xrandr --verbose $args\n\n";
 265       if ($fixes{$name}) {
 266         print "\nThere are known issues with some packages regarding this test.\n";
 267         print "Please verify that you have at least the following git versions\n";
 268         print "before reporting a bug to xorg-devel:\n\n";
 269         print "    $fixes{$name}\n\n";
 270       }
 271       exit 1;
 272     }
 273     eval $inbetween;
 274   } else {
 275     print "->  ignored\n\n";
 276   }
 277 }
 278
 279
 280 # Test cases
 281 #
 282 # The tests are carefully designed to test certain transitions between
 283 # RandR states that can only be reached by certain calling sequences.
 284 # So be careful with altering them. For additional tests, better add them
 285 # to the end of already existing tests of one part.
 286
 287 # Part 1: Single output switching tests (except for trivial explicit --crtc)
 288 t ("p",   "",                        "$oa --off $ob --off");
 289 t ("s1",  "A: $sa1(0)",              "$oa $ma1 --crtc 0");
 290 t ("s2",  "A: $sa1(0)  B: $sab(1)",  "$ob $mab");
 291 # TODO: should be A: $sab(1) someday (auto re-cloning)"
 292 #t ("s3",  "A: $sab(1)  B: $sab(1)",  "$oa $mab");
 293 t ("s3",  "A: $sab(0)  B: $sab(1)",  "$oa $mab --crtc 0");
 294 t ("p4",  "A: $sab(1)  B: $sab(1)",  "$oa $mab --crtc 1 $ob --crtc 1");
 295 t ("s4",  "A: $sa2(0)  B: $sab(1)",  "$oa $ma2");
 296 t ("s5",  "A: $sa1(0)  B: $sab(1)",  "$oa $ma1");
 297 t ("s6",  "A: $sa1(0)  B: $sb1(1)",  "$ob $mb1");
 298 t ("s7",  "A: $sab(0)  B: $sb1(1)",  "$oa $mab");
 299 t ("s8",  "A: $sab(0)  B: $sb2(1)",  "$ob $mb2");
 300 t ("s9",  "A: $sab(0)  B: $sb1(1)",  "$ob $mb1");
 301 # TODO: should be B: $sab(0) someday (auto re-cloning)"
 302 #t ("s10", "A: $sab(0)  B: $sab(0)",  "$ob $mab");
 303 t ("p11", "A: $sab(0)  B: $sab(0)",  "$oa --crtc 0 $ob $mab --crtc 0");
 304 t ("s11", "A: $sa1(1)  B: $sab(0)",  "$oa $ma1");
 305 t ("s12", "A: $sa1(1)  B: $sb1(0)",  "$ob $mb1");
 306 t ("s13", "A: $sa1(1)  B: $sab(0)",  "$ob $mab");
 307 t ("s14", "A: $sa2(1)  B: $sab(0)",  "$oa $ma2");
 308 t ("s15", "A: $sa1(1)  B: $sab(0)",  "$oa $ma1");
 309 t ("p16", "A: $sab(0)  B: $sab(0)",  "$oa $mab --crtc 0 $ob --crtc 0");
 310 t ("s16", "A: $sab(1)  B: $sab(0)",  "$oa --pos 10x0");
 311 t ("p17", "A: $sab(0)  B: $sab(0)",  "$oa --crtc 0 $ob --crtc 0");
 312 t ("s17", "A: $sab(0)  B: $sab(1)",  "$ob --pos 10x0");
 313 t ("p18", "A: $sab(0)  B: $sab(0)",  "$oa --crtc 0 $ob --crtc 0");
 314 # TODO: s18-s19 are known to fail
 315 t ("s18", "A: $sab(1)  B: $sab(0)",  "$oa --crtc 1");
 316 t ("p19", "A: $sab(1)  B: $sab(1)",  "$oa --crtc 1 $ob --crtc 1");
 317 t ("s19", "A: $sab(0)  B: $sab(1)",  "$oa --pos 10x0");
 318
 319 # Part 2: Complex dual output switching tests
 320 # TODO: d1 is known to fail
 321 t ("pd1", "A: $sab(0)",              "$oa --crtc 0 $ob --off");
 322 t ("d1",  "B: $sab(0)",              "$oa --off $ob $mab");
 323
 324 # Done
 325
 326 print "All tests succeeded.\n";
 327
 328 exit 0;
 329