ltpmenu2.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Curses::UI();
   5 use File::Temp();
   6 use diagnostics;
   7
   8 use Carp ();
   9 local $SIG{__WARN__} = \&Carp::cluck;
  10
  11 package LTPTests;
  12 use List::MoreUtils qw/any uniq/;
  13
  14 my $runtest_dir="/usr/lib/ltp/tests/linux/runtest";
  15 #my $runtest_dir="runtest";
  16 my %static_env = (
  17     LTPRESULTS => "/var/cache/ltp/results",
  18     LTPROOT => "/usr/lib/ltp/tests/linux",
  19     TOOLSDIR => "/usr/lib/ltp/tools",
  20     LTPTOOLS => "/usr/lib/ltp/tools",
  21     PATH => "$ENV{PATH}:/usr/lib/ltp/tests/linux/testcases/bin",
  22     TMP => $ENV{TMP} // $ENV{TMPDIR} // "/tmp",
  23     TMPFILE => undef,
  24     );
  25 my @test_data = ();
  26
  27 sub shell_quote
  28 {
  29     my $arg=shift;
  30     $arg =~ s/'/'\\''/;
  31     return "'$arg'";
  32 }
  33
  34 sub to_number
  35 {
  36     my $arg=shift;
  37     return $arg if $arg =~ /^\d+$/;
  38     return 0;
  39 }
  40
  41 sub execute_tests
  42 {
  43     my ($used_tests, $environment, $setup, $teardown) = @_;
  44     my $panopts="";
  45     for(keys %$environment) {
  46         if (/^\$/) {
  47             my $value=$environment->{$_};
  48             s/^\$//;
  49             $ENV{$_}=$value;
  50         }
  51     }
  52     for(keys %static_env) {
  53         my $value=$static_env{$_};
  54         $ENV{$_}=$value;
  55     }
  56     if(($environment->{output} // "") ne "") {
  57         $panopts.=" -o ".shell_quote($environment->{output});
  58     }
  59
  60     if(($environment->{failfile} // "") ne "") {
  61         my $ff=$environment->{failfile};
  62         my $out=$environment->{output}//"";
  63         $out =~ s/^.*\///;
  64         $ff =~ s/%s/$out/;
  65         $panopts.=" -C ".shell_quote($ff);
  66     }
  67
  68     if(($environment->{logfile} // "") ne "") {
  69         my $ff=$environment->{logfile};
  70         my $out=$environment->{output}//"";
  71         $out =~ s/^.*\///;
  72         $ff =~ s/%s/$out/;
  73         my $now = localtime;
  74         $ff =~ s/%d/$now/;
  75         $panopts.=" -l ".shell_quote($ff);
  76     }
  77
  78     my $count;
  79     if(($environment->{count} // "") ne "") {
  80         $count=$environment->{count};
  81         if($count =~ /^(\d)l$/) {
  82             $count=$1*@$used_tests;
  83         }
  84         $count=to_number($count);
  85     }
  86     if($environment->{random}) {
  87         $count = $count // scalar @$used_tests;
  88     }
  89
  90     if(!($environment->{random})) {
  91         $panopts.=" -S";
  92     }
  93
  94     if(defined($count)) {
  95         $panopts.=" -s ".$count;
  96     }
  97
  98     if(($environment->{time} // "") ne "") {
  99         return if !$environment->{time} =~ /[0-9]+[hmsd]?/;
 100         $panopts.=" -t ".$environment->{time};
 101     }
 102
 103     if(($environment->{parallel} // "") ne "") {
 104         $panopts.=" -x ".to_number ($environment->{parallel} // 0);
 105     }
 106
 107     my $ft=new File::Temp(TEMPLATE => "/tmp/runtestXXXXXXXXX");
 108     local $,="\n";
 109     print $ft map { "$_->{id} $_->{command}" } @$used_tests;
 110     $ft->flush;
 111     system "@$setup";
 112     system '${LTPTOOLS}/pan -q -p -n $$ -a '.$zoo->filename.' -f '.$ft->filename.$panopts;
 113     system "@$teardown";
 114 }
 115
 116 my %testsuites =();
 117 my %test_hash= ();
 118 sub load_file
 119 {
 120     my ($file)=@_;
 121     my $num=0;
 122     open(FILE, "<$file");
 123     my $name="$file";
 124     my $ts_desc={ selected => 0, tests => [] };
 125     my $allvars = [];
 126     my $allsetup = [];
 127
 128     my $last;
 129     my $comment=sub {
 130         if($1 =~ /DESCRIPTION:(.*)/) {
 131             $ts_desc->{description}=$1;
 132             $last=\$ts_desc->{description};
 133         } elsif ($1 =~ /ALL:(.*)/) {
 134             push @$allvars, grep m/./, (split qr/ +/, $1);
 135         } elsif ($1 =~ /SETUP:(.*)/) {
 136             push @$allsetup, grep m/./, (split qr/ +/, $1);
 137         } elsif ($1 eq "") {
 138             undef $last;
 139         } elsif(defined $last) {
 140             $$last.="\n". $1;
 141         }
 142
 143     };
 144     while(<FILE>) {
 145         if (/^#(.*)/) {
 146             $comment-> ($1);
 147             next;
 148         }
 149         next unless /^([^[:space:]]+)[[:space:]]+(.*)/;
 150         $comment-> ("");
 151         if(exists($test_hash{"$1 $2"})) {
 152             next if exists $test_hash{"$1 $2"}->{files}->{$name};
 153             push @{$ts_desc->{tests}}, $test_hash{"$1 $2"};
 154             $test_hash{"$1 $2"}->{files}->{$name}=undef;
 155             $ts_desc->{selected}++ if($test_hash{"$1 $2"}->{selected});
 156         } else {
 157             push(@test_data, { id => $1, command => $2,
 158                  files => {$name => undef}});
 159             my $id="$1 $2";
 160             $test_data[$#test_data]->{vars}=[(grep { /^\$(.*)/; !exists($static_env{$1}) } ( @$allvars, $2 =~ /\$[[:alpha:]][[:alnum:]_]*/g ))];
 161             $test_data[$#test_data]->{setup}=$allsetup;
 162             push @{$ts_desc->{tests}}, \%{$test_data[$#test_data]};
 163             $test_hash{$id}=\%{$test_data[$#test_data]};
 164             $testsuites{"<ALL>"}->{count}++;
 165         }
 166         $num++;
 167     }
 168     close (FILE);
 169     $ts_desc->{count}=$num;
 170     $testsuites{$name}=$ts_desc;
 171 }
 172
 173 sub load_available
 174 {
 175     $testsuites{"<ALL>"}={selected => 0, count => 0, tests => \@test_data};
 176
 177     my @files;
 178     opendir(DIR, $runtest_dir) || die("Couldn't open directory $runtest_dir");
 179     @files=readdir(DIR);
 180     closedir(DIR);
 181
 182     foreach(@files) {
 183         next if (/^\./);
 184         load_file("$runtest_dir/$_");
 185     }
 186
 187 }
 188
 189 sub flatten
 190 {
 191     return map { (ref($_) eq "ARRAY") ? flatten(@$_) : $_ } @_;
 192 }
 193
 194 sub needed_vars
 195 {
 196     my ($ts_list)=@_;
 197     return uniq(flatten(map $_->{vars}, @$ts_list));
 198 }
 199
 200 sub setup_scripts
 201 {
 202     my ($ts_list)=@_;
 203     return uniq(flatten(map $_->{setup}, @$ts_list));
 204 }
 205
 206 sub tests_needing_vars
 207 {
 208     my ($tests, @vars)=@_;
 209     my %vars_hash=(map { ($_ => undef) } @vars);
 210     return grep { any { exists($vars_hash{$_}) } @{$_->{vars}} } @$tests;
 211 }
 212
 213 load_available;
 214
 215 package Layout::Proportional;
 216
 217 use Curses::UI::Container;
 218
 219 our @ISA=qw/Curses::UI::Container/;
 220
 221 sub new {
 222     my $class = shift;
 223     my $self = $class->SUPER::new( @_, -layoutorder => [] );
 224     return $self;
 225 }
 226
 227 sub add {
 228     my $self=shift;
 229     my $ret=$self->SUPER::add(@_);
 230     push @{$self->{-layoutorder}}, $self->{-object2id}->{$ret};
 231     return $ret;
 232 }
 233
 234 sub layout {
 235     my $self = shift;
 236     $self->Curses::UI::Widget::layout();
 237
 238     my $size=($self->{-vertical} ? "height" : "width");
 239     my $coord=($self->{-vertical} ? "y" : "x");
 240     my $ot_size=($self->{-vertical} ? "width" : "height");
 241     my $ot_coord=($self->{-vertical} ? "x" : "y");
 242     my $padding=($self->{-vertical} ?
 243                  sub { my $obj=shift; return ($obj->{-padtop}//0)+($obj->{-padbottom}//0); } :
 244                  sub { my $obj=shift; return ($obj->{-padleft}//0)+($obj->{-padright}//0); });
 245     my $total_min=0;
 246     my $total_mult=0;
 247     my %sizes= ( height => $self->canvasheight(), width => $self->canvaswidth() );
 248     foreach(@{$self->{-layoutorder}}) {
 249         my $obj=$self->{-id2object}->{$_};
 250         $total_min += $obj->{"-min-$size"} if $obj->{"-min-$size"};
 251         $total_mult += $obj->{"-mult-$size"} if $obj->{"-mult-$size"};
 252     }
 253     my $excess = $sizes{$size}-$total_min;
 254     my $ratio=($total_mult==0 ? 0 : $excess/$total_mult);
 255
 256     my $cur=0;
 257     foreach(@{$self->{-layoutorder}}) {
 258         my $obj=$self->{-id2object}->{$_};
 259         $obj->{-$coord}=$cur;
 260         $obj->{-$ot_coord}=0;
 261         $obj->{-$size}=int (($obj->{"-min-$size"} // 0) + ($obj->{"-mult-$size"} // 0)*$ratio);
 262         $cur += $obj->{-$size};
 263         $obj->{-$size} = 0 if $obj->{-$size} < 0;
 264         delete $obj->{-$ot_size};
 265         $obj->{-parent}=$self;
 266         $obj->layout();
 267         $obj->intellidraw();
 268     }
 269     return $self;
 270 }
 271
 272 $INC{"Layout/Proportional.pm"}="";
 273
 274 package ListBox::MultiColumn;
 275
 276 use Curses::UI::Listbox;
 277
 278 our @ISA=qw/Curses::UI::Listbox/;
 279
 280 sub new {
 281     my $class = shift;
 282     my $self = $class->SUPER::new(
 283         -colwidth => [],
 284         "-col-designator" => [],
 285         @_
 286         );
 287     return $self;
 288 }
 289
 290 sub getcolwidth
 291 {
 292     my ($self, $col) = @_;
 293     return $self->{-colwidth}->[$col] if $self->{-colwidth}->[$col];
 294     return 10;
 295 }
 296
 297 sub getlabel {
 298     my ($self, $i) = @_;
 299     my $val = $self->values()->[$i];
 300     my @disp=();
 301     if(ref($val) eq "ARRAY") {
 302         for my $idx (0..$#$val-1) {
 303             my $len=$self->getcolwidth($idx);
 304             push (@disp, $$val[$idx]);
 305         }
 306         push (@disp, $$val[$#$val]);
 307     } elsif(ref($val) eq "HASH") {
 308         my $cd=$self->{"-col-designator"};
 309         return "" unless $cd;
 310         for my $idx (0..$#$cd-1) {
 311             my $len=$self->getcolwidth($idx);
 312             push (@disp, $val->{$cd->[$idx]});
 313         }
 314         push (@disp, $val->{$cd->[$#$cd]});
 315     } else {
 316         @disp=($self->SUPER::getlabel($i));
 317     }
 318     @disp=($self->{"-col-formatter"} ?
 319            $self->{"-col-formatter"}->(@disp) :
 320            @disp);
 321     for (0..$#disp-1) {
 322             my $len=$self->getcolwidth($_);
 323             $disp[$_] = sprintf("%-${len}.${len}s", $disp[$_]);
 324     }
 325     return join("|", @disp);
 326 }
 327
 328 package main;
 329 use List::MoreUtils qw/any/;
 330
 331 #######
 332 # TUI #
 333 #######
 334
 335 $INC{"ListBox/MultiColumn.pm"}="";
 336
 337 my $cui = new Curses::UI (
 338     -clear_on_exit => 1
 339 );
 340 my $tc_list;
 341 my $ts_list;
 342 my $win;
 343
 344 my @opt_template = (
 345     simple_text(label => "Output file", name => "output"),
 346     simple_text(label => "Log file", name => "logfile"),
 347     simple_text(label => "Failed command file", name => "failfile"),
 348     simple_text(label => "Running time", name => "time", validator => '/^\d*[hdms]?$/'),
 349     simple_text(label => "Parallel tests", name => "parallel", validator => '/^\d*$/'),
 350     simple_check(label => "Random tests", name => "random"),
 351     simple_text(label => "Test count", name => "count", validator => '/^\d*l?$/'),
 352     );
 353
 354 my %options =( failfile => "/var/tmp/LTP_RUN_ON_%d.failed",
 355                logfile => "/var/tmp/LTP_RUN_ON_%d.log" );
 356
 357 sub simple_text {
 358     my %params=@_;
 359     return { label => $params{label}, name => $params{name},
 360              create => sub {
 361                  my ($parent, $data, @params) = @_;
 362                  @params=(@params, -regexp => $params{validator}) if exists $params{validator};
 363                  my $lab=$parent->add(undef, "TextEntry", @params);
 364                  $lab->text($data) if defined $data;
 365                  return $lab;
 366              },
 367              get => sub { return shift()->get(); }
 368     };
 369
 370 }
 371
 372 sub simple_check {
 373     my %params=@_;
 374     return { label => $params{label}, name => $params{name},
 375              create => sub {
 376                  my ($parent, $data, @params) = @_;
 377                  my $lab=$parent->add(undef, "Checkbox", @params);
 378                  $lab->check() if $data;
 379                  return $lab;
 380              },
 381              get => sub { return shift()->get(); }
 382     };
 383
 384 }
 385
 386 sub show_opt_dialog
 387 {
 388     options_dialog([@opt_template, map {
 389         +{
 390             label => $_, name => $_,
 391             create => sub {
 392                 my ($parent, $data, @params) = @_;
 393                 my $lab=$parent->add(undef, "TextEntry", @params);
 394                 $lab->text($data) if defined $data;
 395                 return $lab;
 396             },
 397             get => sub { return shift()->get(); }
 398         }
 399                     } LTPTests::needed_vars [grep { $_->{selected} } @test_data]], \%options);
 400 }
 401
 402 sub execute_tests
 403 {
 404     my $selected_tests=[grep { $_->{selected} } @test_data];
 405     my @needed_vars=LTPTests::needed_vars $selected_tests;
 406     my @unsatisfied_tests=LTPTests::tests_needing_vars $selected_tests, (grep !$options{$_}, @needed_vars);
 407     if(@unsatisfied_tests) {
 408         my $response=$cui->dialog(
 409             -message => "You have sellected tests that need setting some variables. Would you like to set them now?",
 410             -buttons => [
 411                  {-label => "Show the options dialog", -value => 0},
 412                  {-label => "Don't run those tests", -value => 1},
 413                  {-label => "Cancel", -value => 2}
 414             ],
 415             -title => "Unset variables"
 416             );
 417         return if($response == 2);
 418         if($response==0) {
 419             show_opt_dialog;
 420         } else { # filter tests
 421             $selected_tests=[grep { !any { !$options{$_} } LTPTests::needed_vars [$_] } @$selected_tests ];
 422         }
 423     }
 424     my @setups = LTPTests::setup_scripts $selected_tests;
 425     $cui->leave_curses();
 426     LTPTests::execute_tests($selected_tests, \%options, ["clear; echo Running LTP Tests; ", map { "$_ setup;" } @setups], [map { "$_ teardown;" } @setups]);
 427     $cui->reset_curses();
 428 }
 429
 430 my $main_menu = [
 431     { -label => "Load", -value => sub {
 432         my $file=$cui->loadfilebrowser();
 433         LTPTests::load_file $file if defined $file;
 434         $ts_list->values([sort keys (%testsuites)]);
 435       } },
 436     { -label => "Execute", -value => \&execute_tests },
 437     { -label => "Options", -value => \&show_opt_dialog },
 438     { -label => "Exit", -value => sub { exit(0) } }
 439 ];
 440
 441 sub update_tc_list
 442 {
 443     my $v=$ts_list->get_active_value();
 444     $tc_list->values($testsuites{$v}->{tests} );
 445     my $seh=$tc_list->{-onchange};
 446     $tc_list->onChange(undef);
 447     $tc_list->set_selection(grep { $tc_list->{-values}->[$_]->{selected} } (0..$#{$tc_list->{-values}}));
 448     $tc_list->onChange($seh);
 449     $tc_list->intellidraw();
 450 }
 451
 452 sub update_tc_selection
 453 {
 454     my @sel=$tc_list->get();
 455     for(@{$tc_list->{-values}}){
 456          if($_->{selected}) {
 457             $_->{selected}=0;
 458             for(keys %{$_->{files}}) {
 459                 $testsuites{$_}->{selected}--;
 460             }
 461             $testsuites{"<ALL>"}->{selected}--;
 462          }
 463     }
 464     foreach (@sel) {
 465         if(!$_->{selected}) {
 466             $_->{selected}=1;
 467             for(keys %{$_->{files}}) {
 468                 $testsuites{$_}->{selected}++;
 469             }
 470             $testsuites{"<ALL>"}->{selected}++;
 471         }
 472     }
 473     $ts_list->intellidraw();
 474 }
 475
 476 sub check_ts
 477 {
 478     update_tc_list();
 479     my $seh=$tc_list->{-onchange};
 480     $tc_list->onChange(undef);
 481     $tc_list->set_selection((0..$#{$tc_list->{-values}}));
 482     $tc_list->onChange($seh);
 483     $seh->($tc_list);
 484     $tc_list->intellidraw();
 485 }
 486
 487 sub uncheck_ts
 488 {
 489     update_tc_list();
 490     $tc_list->clear_selection();
 491     update_tc_selection(); # clear_selection doesn't call -onchange callback
 492     $tc_list->intellidraw();
 493 }
 494
 495 sub toggle_ts
 496 {
 497     my $ts=$testsuites{$ts_list->get_active_value()};
 498     if($ts->{count}>$ts->{selected}) {
 499         check_ts();
 500     } else {
 501         uncheck_ts();
 502     }
 503 }
 504
 505 sub max
 506 {
 507     my $ret=shift;
 508     for(@_) {
 509         $ret=$_ if $_>$ret;
 510     }
 511     return $ret;
 512 }
 513
 514 sub options_dialog
 515 {
 516     my ($template, $options)=@_;
 517
 518     my $dialog=$cui->add(undef, "Window");
 519     my $dialogid=$cui->{-object2id}->{$dialog};
 520
 521     my $line=1;
 522     my $labelwidth=20;
 523
 524     my @widgets=();
 525     for(@$template) {
 526         my $label=$dialog->add(undef, "Label", -text => $_->{label},
 527                                -x => 0, -width => $labelwidth, -y => $line);
 528         push @widgets, $_->{create}->($dialog, $options->{$_->{name}}, -x => $labelwidth+2, -y => $line);
 529
 530         $label->layout();
 531         $line+=max($label->{-h}, $widgets[$#widgets]->{-h});
 532     }
 533
 534     $dialog->add(undef, "Buttonbox", -y => $line+1, -buttons =>[
 535                      { -label => "Ok", -onpress => sub { $dialog->loose_focus; } }
 536                  ]);
 537
 538     $dialog->modalfocus;
 539
 540     for(@$template) {
 541         $options->{$_->{name}}=$_->{get}->(shift(@widgets));
 542     }
 543
 544     $cui->delete($dialogid);
 545     $cui->root->focus(undef, 1);
 546 }
 547
 548 $win = $cui->add("win", "Window", -padtop => 1);
 549
 550 $cui->add (
 551     "menu", "Menubar",
 552     -menu => [ { -label => "File", -submenu=>$main_menu } ]
 553     );
 554
 555 my $cont=$win->add(
 556     "layout", "Layout::Proportional", -vertical => 0, -border => 1
 557     );
 558
 559 $ts_list=$cont->add (
 560     "lb", "ListBox::MultiColumn",
 561     -values => [sort keys (%testsuites)],
 562     -vscrollbar => "right",
 563 #    -padtop => 2, -padleft => 2,
 564 #    -padright => 2, -padbottom => 2,
 565     "-mult-width" => 1, -border => 1,
 566     -onselchange => \&update_tc_list,
 567     "-col-formatter" => sub {
 568         my $tmp=$testsuites{$_[0]} // { selected => 0, count => 1 };
 569         my $pref;
 570         if($tmp->{selected}==0) {
 571             $pref='  ';
 572         } elsif($tmp->{selected}<$tmp->{count}) {
 573             $pref='x ';
 574         } else {
 575             $pref='X ';
 576         }
 577         $_[0]=~s/^(.*\/)//;
 578         $_[0]=$pref.$_[0];
 579         return @_ }
 580     );
 581
 582 $tc_list=$cont->add (
 583     "lb2", "ListBox::MultiColumn",
 584     -values => \@test_data,
 585     "-col-designator" => ["id", "command"],
 586     -vscrollbar => "right",
 587 #    -padtop => 2, -padleft => 2,
 588 #    -padright => 2, -padbottom => 2,
 589     "-mult-width" => 2, -border => 1,
 590     -multi => 1,
 591     -onchange => \&update_tc_selection
 592     );
 593
 594 $ts_list->set_routine('option-check', \&check_ts);
 595 $ts_list->set_routine('option-uncheck', \&uncheck_ts);
 596 $ts_list->set_routine('option-select', \&toggle_ts);
 597
 598 $cui->set_binding( sub{ $cui->focus('menu') }, Curses::KEY_F(10) );
 599
 600 $cui->layout();
 601 $ts_list->focus();
 602 $cui->mainloop();