From 54b087de04bdfa1469a68491699b7f8c3090cfe6 Mon Sep 17 00:00:00 2001 From: svu Date: Mon, 3 May 2004 01:33:31 +0000 Subject: [PATCH] The perl code is a bit structured now --- tests/testLayouts.pl | 12 ++++ tests/testModels.pl | 137 ++--------------------------------------- tests/xkbTestFunc.pm | 141 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 157 insertions(+), 133 deletions(-) create mode 100755 tests/testLayouts.pl create mode 100755 tests/xkbTestFunc.pm diff --git a/tests/testLayouts.pl b/tests/testLayouts.pl new file mode 100755 index 0000000..c022e64 --- /dev/null +++ b/tests/testLayouts.pl @@ -0,0 +1,12 @@ +#!/bin/env perl + +use strict; +use xkbTestFunc; + +backupXkbSettings(); + +dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ); + +testLevel2( "layout", "variant", 2, "(", ")" ); + +restoreXkbSettings(); diff --git a/tests/testModels.pl b/tests/testModels.pl index aaed2a8..f740f6a 100644 --- a/tests/testModels.pl +++ b/tests/testModels.pl @@ -1,141 +1,12 @@ #!/bin/env perl use strict; - -my $origXkbRules; -my $origXkbModel; -my $origXkbLayouts; -my $origXkbOptions; -my $origXkbVariants; - -sub backupXkbSettings -{ - ( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ) = getXkbSettings(); -} - -sub getXkbSettings -{ - my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ); - - open (XPROP, "xprop -root |") or die "Could not start xprop"; - PROP: while () - { - if (/_XKB_RULES_NAMES\(STRING\) = \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\"/) - { - ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = - ( $1, $2, $3, $4, $5 ) ; - last PROP; - } - } - close XPROP; - - return ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ); -} - -sub setXkbSettings -{ - my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_; - ( system ( "setxkbmap", "-synch", - "-rules", $xkbRules, - "-model", $xkbModel, - "-layout", $xkbLayouts, - "-variant", $xkbVariants, - "-option", $xkbOptions ) == 0 ) or die "Could not set xkb configuration"; -} - -sub restoreXkbSettings -{ - setXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ); -} - -sub defaultXkbSettings -{ - return ( "base", "pc105", "us", "", "" ); -} - -sub dumpXkbSettings -{ - my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_; - print "rules: [$xkbRules]\n" ; - print "model: [$xkbModel]\n" ; - print "layouts: [$xkbLayouts]\n" ; - print "variants: [$xkbVariants]\n" ; - print "options: [$xkbOptions]\n" ; -} - -sub testLevel1 -{ - my ( $type, $idx ) = @_; - - open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or - die ( "Could not start xsltproc" ); - while () - { - chomp(); - if (/(\S+)/) - { - my $paramValue=$1; - print "--- setting $type: [$paramValue]\n"; - my @params = defaultXkbSettings(); - @params[$idx] = $paramValue; - dumpXkbSettings ( @params ); - setXkbSettings ( @params ); - #print "--- dump:\n"; - #dumpXkbSettings( getXkbSettings() ); - } - } - close XSLTPROC; -} - -sub testLevel2 -{ - my ( $type, $subtype, $idx, $delim1, $delim2 ) = @_; - - open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or - die ( "Could not start xsltproc" ); - while () - { - chomp(); - if (/(\S+)/) - { - my $paramValue=$1; - print "--- scanning $type: [$paramValue]\n"; - - my @params = defaultXkbSettings(); - @params[$idx] = "$paramValue"; - dumpXkbSettings ( @params ); - setXkbSettings ( @params ); - #print "--- dump:\n"; - #dumpXkbSettings( getXkbSettings() ); - - open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or - die ( "Could not start xsltproc" ); - while () - { - chomp(); - if (/(\S+)/) - { - my $paramValue2=$1; - print " --- $subtype: [$paramValue2]\n"; - my @params = defaultXkbSettings(); - @params[$idx] = "$paramValue$delim1$paramValue2$delim2"; - dumpXkbSettings ( @params ); - setXkbSettings ( @params ); - #print "--- dump:\n"; - #dumpXkbSettings( getXkbSettings() ); - } - } - close XSLTPROa2C; - } - } - close XSLTPROC; -} +use xkbTestFunc; backupXkbSettings(); - + dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ); - -#testLevel1( "model", 1 ); -testLevel2( "layout", "variant", 2, "(", ")" ); + +testLevel1( "model", 1 ); restoreXkbSettings(); diff --git a/tests/xkbTestFunc.pm b/tests/xkbTestFunc.pm new file mode 100755 index 0000000..aaed2a8 --- /dev/null +++ b/tests/xkbTestFunc.pm @@ -0,0 +1,141 @@ +#!/bin/env perl + +use strict; + +my $origXkbRules; +my $origXkbModel; +my $origXkbLayouts; +my $origXkbOptions; +my $origXkbVariants; + +sub backupXkbSettings +{ + ( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ) = getXkbSettings(); +} + +sub getXkbSettings +{ + my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ); + + open (XPROP, "xprop -root |") or die "Could not start xprop"; + PROP: while () + { + if (/_XKB_RULES_NAMES\(STRING\) = \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\", \"(.*)\"/) + { + ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = + ( $1, $2, $3, $4, $5 ) ; + last PROP; + } + } + close XPROP; + + return ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ); +} + +sub setXkbSettings +{ + my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_; + ( system ( "setxkbmap", "-synch", + "-rules", $xkbRules, + "-model", $xkbModel, + "-layout", $xkbLayouts, + "-variant", $xkbVariants, + "-option", $xkbOptions ) == 0 ) or die "Could not set xkb configuration"; +} + +sub restoreXkbSettings +{ + setXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ); +} + +sub defaultXkbSettings +{ + return ( "base", "pc105", "us", "", "" ); +} + +sub dumpXkbSettings +{ + my ( $xkbRules, $xkbModel, $xkbLayouts, $xkbVariants, $xkbOptions ) = @_; + print "rules: [$xkbRules]\n" ; + print "model: [$xkbModel]\n" ; + print "layouts: [$xkbLayouts]\n" ; + print "variants: [$xkbVariants]\n" ; + print "options: [$xkbOptions]\n" ; +} + +sub testLevel1 +{ + my ( $type, $idx ) = @_; + + open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or + die ( "Could not start xsltproc" ); + while () + { + chomp(); + if (/(\S+)/) + { + my $paramValue=$1; + print "--- setting $type: [$paramValue]\n"; + my @params = defaultXkbSettings(); + @params[$idx] = $paramValue; + dumpXkbSettings ( @params ); + setXkbSettings ( @params ); + #print "--- dump:\n"; + #dumpXkbSettings( getXkbSettings() ); + } + } + close XSLTPROC; +} + +sub testLevel2 +{ + my ( $type, $subtype, $idx, $delim1, $delim2 ) = @_; + + open ( XSLTPROC, "xsltproc --stringparam type $type listCIs.xsl ../rules/base.xml.in |" ) or + die ( "Could not start xsltproc" ); + while () + { + chomp(); + if (/(\S+)/) + { + my $paramValue=$1; + print "--- scanning $type: [$paramValue]\n"; + + my @params = defaultXkbSettings(); + @params[$idx] = "$paramValue"; + dumpXkbSettings ( @params ); + setXkbSettings ( @params ); + #print "--- dump:\n"; + #dumpXkbSettings( getXkbSettings() ); + + open ( XSLTPROC2, "xsltproc --stringparam type $subtype --stringparam parentId $paramValue listCI2.xsl ../rules/base.xml.in |" ) or + die ( "Could not start xsltproc" ); + while () + { + chomp(); + if (/(\S+)/) + { + my $paramValue2=$1; + print " --- $subtype: [$paramValue2]\n"; + my @params = defaultXkbSettings(); + @params[$idx] = "$paramValue$delim1$paramValue2$delim2"; + dumpXkbSettings ( @params ); + setXkbSettings ( @params ); + #print "--- dump:\n"; + #dumpXkbSettings( getXkbSettings() ); + } + } + close XSLTPROa2C; + } + } + close XSLTPROC; +} + +backupXkbSettings(); + +dumpXkbSettings( $origXkbRules, $origXkbModel, $origXkbLayouts, $origXkbVariants, $origXkbOptions ); + +#testLevel1( "model", 1 ); +testLevel2( "layout", "variant", 2, "(", ")" ); + +restoreXkbSettings(); -- 2.32.0.93.g670b81a890