The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use strict;
use warnings FATAL => qw(all);
###
### variant of test.pl for Tk:ObjScanner, with additional test cases
### by R Farkas rudif@lecroy.com 27 Jun 1999
###

use Test::More ;
use Tk ;
use ExtUtils::testlib ;
BEGIN { use_ok ('Tk::ObjScanner') ; };


my $trace = shift || 0 ;


package toto ;

use FileHandle;
use Benchmark;
use Math::BigInt;

sub new {
     my $type = shift;
     # add recursive data only if interactive test
     my $tkstuff = $trace ? shift : "may be another time ..." ;

     my $scl = 'my scalar var';

    my $self = { 'scalar: key1'    => 'value1',
                 'ref array:'            => [qw/a b sdf/, {'v1' => '1', 'v2' =>
2},'dfg'],
                 'ref hash: key2'  => {
                                         'sub key1' => 'sv1',
                                         'sub key2' => 'sv2'
                                              },
                 'ref hash: piped|key'   => {a => 1 , b => 2},
                 'scalar: long'          => 'very long line'.'.' x 80 ,
                 'scalar: is undef'      => undef,
                 'scalar: some text'     => "some \n dummy\n Text\n",
                 'ref blessed hash: tk widget' => $tkstuff,

                    'ref const'          => \12345,
                    'ref scalar'         => \$scl,
                    'ref ref tk widget'  => \$tkstuff,            # ref to ref (assumes $tkstuff is a ref)
                    'ref code'                => sub { my $x = shift; sin($x) +
cos(2*$x) },
                    'ref blessed glob'   => new FileHandle,
                    'ref blessed array' => new Benchmark,
                    'ref blessed scalar' => new Math::BigInt '123 456 789 123
456 789',

             } ;

    bless $self,$type;
  }

package main;

SKIP: {
    my $toto ;
    my $mw = eval { MainWindow-> new ; };

    # cannot create Tk window
    if (not $mw) {
        skip "Cannot create Tk window", 1 ;
        done_testing ;
        exit;
    }

$mw->geometry('+10+10');

my $w_menu = $mw->Frame(-relief => 'raised', -borderwidth => 2);
$w_menu->pack(-fill => 'x');

my $f = $w_menu->Menubutton(-text => 'File', -underline => 0)
  -> pack(-side => 'left' );
$f->command(-label => 'Quit',  -command => sub{$mw->destroy;} );


my $dummy = new toto ($mw);
    ok($dummy, "created dummy object");

my $s = $mw -> ObjScanner
  (
   'caller' => $dummy,
   title => 'test scanner'
  );
$s  -> pack(-expand => 1, -fill => 'both') ;
    ok($s, "Created obj scanner");

$mw->idletasks;

sub scan {
    my $topName = shift ;
        ok(1, "view $topName");
    $s->yview($topName) ;
    $mw->after(200); # sleep 300ms

    foreach my $c ($s->infoChildren($topName)) {
        $s->displaySubItem($c);
        scan($c);
      }
    $mw->idletasks;
  }

if ($trace) {
    MainLoop ; # Tk's
  }
else {
    scan('root');
  }

}

done_testing;