diff options
Diffstat (limited to 'xrandr/xrandr_test.pl')
| -rwxr-xr-x | xrandr/xrandr_test.pl | 329 |
1 files changed, 329 insertions, 0 deletions
diff --git a/xrandr/xrandr_test.pl b/xrandr/xrandr_test.pl new file mode 100755 index 0000000..fcdf1ce --- /dev/null +++ b/xrandr/xrandr_test.pl @@ -0,0 +1,329 @@ +#!/usr/bin/perl + +# +# xrandr Test suite +# +# Do a set of xrandr calls and verify that the screen setup is as expected +# after each call. +# + +$xrandr="xrandr"; +$xrandr=$ENV{XRANDR} if defined $ENV{XRANDR}; +$version="0.1"; +$inbetween=""; +print "\n***** xrandr test suite V$version *****\n\n"; + +# Known issues and their fixes +%fixes=( + s2 => "xrandr: 307f3686", + s4 => "xserver: f7dd0c72", + s11 => "xrandr: f7aaf894", + s18 => "issue known, but not fixed yet" +); + +# Get output configuration +@outputs=(); +%mode_name=(); +%out_modes=(); +%modes=(); +open P, "$xrandr --verbose|" or die "$xrandr"; +while (<P>) { + if (/^\S/) { + $o=""; $m=""; $x=""; + } + if (/^(\S+)\s(connected|unknown connection)\s/) { + $o=$1; + push @outputs, $o if $2 eq "connected"; + push @outputs_unknown, $o if $2 eq "unknown connection"; + $out_modes{$o}=[]; + } elsif (/^\s+(\d+x\d+)\s+\((0x[0-9a-f]+)\)/) { + my $m=$1; + my $x=$2; + while (<P>) { + if (/^\s+(\d+x\d+)\s+\((0x[0-9a-f]+)\)/) { + print "WARNING: Ignoring incomplete mode $x:$m on $o\n"; + $m=$1, $x=$2; + } elsif (/^\s+v:.*?([0-9.]+)Hz\s*$/) { + if (defined $mode_name{$x} && $mode_name{$x} ne "$m\@$1") { + print "WARNING: Ignoring mode $x:$m\@$1 because $x:$mode_name{$x} already exists\n"; + last; + } + if (defined $modes{"$o:$x"}) { + print "WARNING: Ignoring duplicate mode $x on $o\n"; + last; + } + $mode_name{$x}="$m\@$1"; + push @{$out_modes{$o}}, $x; + $modes{"$o:$x"}=$x; + $modes{"$o:$m\@$1"}=$x; + $modes{"$o:$m"}=$x; + last; + } + } + } +} +close P; +@outputs=(@outputs,@outputs_unknown) if @outputs < 2; + +# preamble +if ($ARGV[0] eq "-w") { + print "Waiting for keypress after each test for manual verification.\n\n"; + $inbetween='print " Press <Return> to continue...\n"; $_=<STDIN>'; +} elsif ($ARGV[0] ne "") { + print "Preparing for test # $ARGV[0]\n\n"; + $prepare = $ARGV[0]; +} + +print "Detected connected outputs and available modes:\n\n"; +for $o (@outputs) { + print "$o:"; + my $i=0; + for $x (@{$out_modes{$o}}) { + print "\n" if $i++ % 3 == 0; + print " $x:$mode_name{$x}"; + } + print "\n"; +} +print "\n"; + +if (@outputs < 2) { + print "Found less than two connected outputs. No tests available for that.\n"; + exit 1; +} +if (@outputs > 2) { + print "Note: No tests for more than two connected outputs available yet.\n"; + print "Using the first two outputs.\n\n"; +} + +$a=$outputs[0]; +$b=$outputs[1]; + +# For each resolution only a single refresh rate should be used in order to +# reduce ambiguities. For that we need to find unused modes. The %used hash is +# used to track used ones. All references point to <id>. +# <output>:<id> +# <output>:<width>x<height>@<refresh> +# <output>:<width>x<height> +# <id> +# <width>x<height>@<refresh> +# <width>x<height> +%used=(); + +# Find biggest common mode +undef $sab; +for my $x (@{$out_modes{$a}}) { + if (defined $modes{"$b:$x"}) { + $m=$mode_name{$x}; + $sab="$x:$m"; + $m =~ m/(\d+x\d+)\@([0-9.]+)/; + $used{$x} = $x; + $used{$1} = $x; + $used{"$a:$x"} = $x; + $used{"$b:$x"} = $x; + $used{"$a:$m"} = $mode_name{$x}; + $used{"$b:$m"} = $mode_name{$x}; + $used{"$a:$1"} = $x; + $used{"$b:$1"} = $x; + last; + } +} +if (! defined $sab) { + print "Cannot find common mode between $a and $b.\n"; + print "Test suite is designed to need a common mode.\n"; + exit 1; +} + +# Find sets of additional non-common modes +# Try to get non-overlapping resolution set, but if that fails get overlapping +# ones but with different refresh values, if that fails any with nonequal +# timings, and if that fails any one, but warn. +# Try modes unknown to other outputs first, they might need common ones +# themselves. +sub get_mode { + my $o=$_[0]; + for my $pass (1, 2, 3, 4, 5, 6, 7, 8, 9) { + CONT: for my $x (@{$out_modes{$o}}) { + $m = $mode_name{$x}; + $m =~ m/(\d+x\d+)\@([0-9.]+)/; + next CONT if defined $used{"$o:$x"}; + next CONT if $pass < 9 && defined $used{"$o:$m"}; + next CONT if $pass < 7 && defined $used{"$o:$1"}; + next CONT if $pass < 6 && defined $used{$m}; + next CONT if $pass < 4 && defined $used{$1}; + for my $other (@outputs) { + next if $other eq $o; + next CONT if $pass < 8 && defined $used{"$o:$x"}; + next CONT if $pass < 5 && $used{"$other:$1"}; + next CONT if $pass < 3 && $modes{"$other:$m"}; + next CONT if $pass < 2 && $modes{"$other:$1"}; + } + if ($pass >= 6) { + print "Warning: No more non-common modes, using $m for $o\n"; + } + $used{"$o:$x"} = $x; + $used{"$o:$m"} = $x; + $used{"$o:$1"} = $x; + $used{$x} = $x; + $used{$m} = $x; + $used{$1} = $x; + return "$x:$m"; + } + } + print "Warning: Cannot find any more modes for $o.\n"; + return undef; +} +sub mode_to_randr { + $_[0] =~ m/^(0x[0-9a-f]+):(\d+)x(\d+)\@([0-9.]+)/; + return "--mode $1"; +} + +$sa1=get_mode($a); +$sa2=get_mode($a); +$sb1=get_mode($b); +$sb2=get_mode($b); + +$mab=mode_to_randr($sab); +$ma1=mode_to_randr($sa1); +$ma2=mode_to_randr($sa2); +$mb1=mode_to_randr($sb1); +$mb2=mode_to_randr($sb2); + +# Shortcuts +$oa="--output $a"; +$ob="--output $b"; + +# Print config +print "A: $a (mab,ma1,ma2)\nB: $b (mab,mb1,mb2)\n\n"; +print "mab: $sab\nma1: $sa1\nma2: $sa2\nmb1: $sb1\nmb2: $sb2\n\n"; +print "Initial config:\n"; +system "$xrandr"; +print "\n"; + +# Test subroutine +sub t { + my $name=$_[0]; + my $expect=$_[1]; + my $args=$_[2]; + print "*** $name: $args\n"; + print "? $expect\n" if $expect ne ""; + if ($name eq $prepare) { + print "-> Prepared to run test\n\nRun test now with\n$xrandr --verbose $args\n\n"; + exit 0; + } + my %r = (); + my $r = ""; + my $out = ""; + if (system ("$xrandr --verbose $args") == 0) { + # Determine active configuration + open P, "$xrandr --verbose|" or die "$xrandr"; + my ($o, $c, $m, $x); + while (<P>) { + $out.=$_; + if (/^\S/) { + $o=""; $c=""; $m=""; $x=""; + } + if (/^(\S+)\s(connected|unknown connection) (\d+x\d+)\+\d+\+\d+\s+\((0x[0-9a-f]+)\)/) { + $o=$1; + $m=$3; + $x=$4; + $o="A" if $o eq $a; + $o="B" if $o eq $b; + } elsif (/^\s*CRTC:\s*(\d)/) { + $c=$1; + } elsif (/^\s+$m\s+\($x\)/) { + while (<P>) { + $out.=$_; + if (/^\s+\d+x\d+\s/) { + $r{$o}="$x:$m\@?($c)" unless defined $r{$o}; + # we don't have to reparse this - something is wrong anyway, + # and it probably is no relevant resolution as well + last; + } elsif (/^\s+v:.*?([0-9.]+)Hz\s*$/) { + $r{$o}="$x:$m\@$1($c)"; + last; + } + } + } + } + for $o (sort keys %r) { + $r .= " $o: $r{$o}"; + } + close P; + } else { + $expect="success" if $expect=""; + $r="failed"; + } + # Verify + if ($expect ne "") { + print "->$r\n"; + if ($r eq " $expect") { + print "-> ok\n\n"; + } else { + print "\n$out"; + print "\n-> FAILED: Test # $name:\n\n"; + print " $xrandr --verbose $args\n\n"; + if ($fixes{$name}) { + print "\nThere are known issues with some packages regarding this test.\n"; + print "Please verify that you have at least the following git versions\n"; + print "before reporting a bug to xorg-devel:\n\n"; + print " $fixes{$name}\n\n"; + } + exit 1; + } + eval $inbetween; + } else { + print "-> ignored\n\n"; + } +} + + +# Test cases +# +# The tests are carefully designed to test certain transitions between +# RandR states that can only be reached by certain calling sequences. +# So be careful with altering them. For additional tests, better add them +# to the end of already existing tests of one part. + +# Part 1: Single output switching tests (except for trivial explicit --crtc) +t ("p", "", "$oa --off $ob --off"); +t ("s1", "A: $sa1(0)", "$oa $ma1 --crtc 0"); +t ("s2", "A: $sa1(0) B: $sab(1)", "$ob $mab"); +# TODO: should be A: $sab(1) someday (auto re-cloning)" +#t ("s3", "A: $sab(1) B: $sab(1)", "$oa $mab"); +t ("s3", "A: $sab(0) B: $sab(1)", "$oa $mab --crtc 0"); +t ("p4", "A: $sab(1) B: $sab(1)", "$oa $mab --crtc 1 $ob --crtc 1"); +t ("s4", "A: $sa2(0) B: $sab(1)", "$oa $ma2"); +t ("s5", "A: $sa1(0) B: $sab(1)", "$oa $ma1"); +t ("s6", "A: $sa1(0) B: $sb1(1)", "$ob $mb1"); +t ("s7", "A: $sab(0) B: $sb1(1)", "$oa $mab"); +t ("s8", "A: $sab(0) B: $sb2(1)", "$ob $mb2"); +t ("s9", "A: $sab(0) B: $sb1(1)", "$ob $mb1"); +# TODO: should be B: $sab(0) someday (auto re-cloning)" +#t ("s10", "A: $sab(0) B: $sab(0)", "$ob $mab"); +t ("p11", "A: $sab(0) B: $sab(0)", "$oa --crtc 0 $ob $mab --crtc 0"); +t ("s11", "A: $sa1(1) B: $sab(0)", "$oa $ma1"); +t ("s12", "A: $sa1(1) B: $sb1(0)", "$ob $mb1"); +t ("s13", "A: $sa1(1) B: $sab(0)", "$ob $mab"); +t ("s14", "A: $sa2(1) B: $sab(0)", "$oa $ma2"); +t ("s15", "A: $sa1(1) B: $sab(0)", "$oa $ma1"); +t ("p16", "A: $sab(0) B: $sab(0)", "$oa $mab --crtc 0 $ob --crtc 0"); +t ("s16", "A: $sab(1) B: $sab(0)", "$oa --pos 10x0"); +t ("p17", "A: $sab(0) B: $sab(0)", "$oa --crtc 0 $ob --crtc 0"); +t ("s17", "A: $sab(0) B: $sab(1)", "$ob --pos 10x0"); +t ("p18", "A: $sab(0) B: $sab(0)", "$oa --crtc 0 $ob --crtc 0"); +# TODO: s18-s19 are known to fail +t ("s18", "A: $sab(1) B: $sab(0)", "$oa --crtc 1"); +t ("p19", "A: $sab(1) B: $sab(1)", "$oa --crtc 1 $ob --crtc 1"); +t ("s19", "A: $sab(0) B: $sab(1)", "$oa --pos 10x0"); + +# Part 2: Complex dual output switching tests +# TODO: d1 is known to fail +t ("pd1", "A: $sab(0)", "$oa --crtc 0 $ob --off"); +t ("d1", "B: $sab(0)", "$oa --off $ob $mab"); + +# Done + +print "All tests succeeded.\n"; + +exit 0; + |