The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# test for client data handling in various controls

use strict;
use Wx;
use lib './t';
use Tests_Helper qw(in_frame);
use Wx::Event qw(EVT_BUTTON);

package MyClass;

sub new {
  my $class = shift;
  my $code = shift;
  die "want a CODE reference" unless ref $code eq 'CODE';

  return bless [ $code ], $class;
}

sub DESTROY { &{$_[0][0]} }

package main;

use Test::More 'tests' => 65;

use strict;
#use base 'Wx::Frame';
use vars '$TODO';

sub tdata($) { Wx::TreeItemData->new( MyClass->new( $_[0] ) ) }
sub cdata($) { MyClass->new( $_[0] ) }

sub tests {
  my $this = shift;

  ############################################################################
  # wxTreeCtrl
  ############################################################################

  my $tree = Wx::TreeCtrl->new( $this, -1 );
  my $root = $tree->AddRoot( 'Root', -1, -1,
                             Wx::TreeItemData->new( 'Frobnicate' ) );

  my $trdata = $tree->GetItemData( $root );
  my $data = $trdata->GetData();
  is( $data, 'Frobnicate', "Wx::TreeItemData::GetData" );
  $data = $trdata->GetData();

  is( $data, 'Frobnicate', "Wx::TreeItemData::GetData (again)" );
  $data = $tree->GetPlData( $root );
  is( $data, 'Frobnicate', "Wx::TreeCtrl::GetPlData" );

  $trdata = $tree->GetItemData( $root );
  $trdata->SetData( 'Baz' );
  $trdata = $tree->GetItemData( $root );
  $data = $trdata->GetData();
  is( $data, 'Baz', "Wx::TreeItemData::SetData" );
  $tree->SetItemData( $root, Wx::TreeItemData->new( 'Boo' ) );
  $data = $tree->GetPlData( $root );
  is( $data, 'Boo', "Wx::TreeCtrl::SetItemData" );
  $tree->SetPlData( $root, 'XyZ' );
  $data = $tree->GetPlData( $root );
  is( $data, 'XyZ', "Wx::TreeCtrl::SetPlData" );

  # test deleting and setting again
  my( $deleting, $setting, $ctrldelete ) = ( 0, 0, 0 );

  my $item1 = $tree->AppendItem( $root, 'An item', -1, -1,
                                 tdata sub { $deleting = 1 } );
  my $item2 = $tree->AppendItem( $root, 'An item', -1, -1,
                                 tdata sub { $setting = 1 } );
  my $item3 = $tree->AppendItem( $root, 'An item', -1, -1,
                                 tdata sub { $ctrldelete = 1 } );

  $tree->Delete( $item1 );
  ok( $deleting, 'WxTreeCtrl: deleting an item deletes the data' );
  $tree->SetItemData( $item2, Wx::TreeItemData->new( 'foo' ) );
  ok( $setting, 'Wx::TreeCtrl: setting again item data deletes old data' );
  # and hope the tree is deleted NOW
  $tree->Destroy;
  ok( $ctrldelete, 'Wx::TreeCtrl: deleting the tree deletes the data' );
  
  ############################################################################
  # wxTreeListCtrl
  ############################################################################
  
  SKIP: {
    skip 'No Native Wx::TreeListCtrl', 8 unless defined(&Wx::TreeListCtrl::new);

    my $treelist = Wx::TreeListCtrl->new( $this, -1,  );
    $treelist->AppendColumn("Component",
                       &Wx::wxCOL_WIDTH_AUTOSIZE,
                       &Wx::wxALIGN_LEFT,
                       &Wx::wxCOL_RESIZABLE | &Wx::wxCOL_SORTABLE);
    $treelist->AppendColumn("# Files",
                       $treelist->WidthFor("1,000,000"),
                       &Wx::wxALIGN_RIGHT,
                       &Wx::wxCOL_RESIZABLE | &Wx::wxCOL_SORTABLE);
    $treelist->AppendColumn("Size",
                       $treelist->WidthFor("1,000,000 KiB"),
                       &Wx::wxALIGN_RIGHT,
                       &Wx::wxCOL_RESIZABLE | &Wx::wxCOL_SORTABLE);    
    
    my $tlroot = $treelist->GetRootItem();
    ok( $tlroot->IsOk, 'Wx::TreeListCtrl Root item OK');
    my $tldata = \'Hubris';
    $treelist->SetItemData($tlroot, $tldata);
    
    my $outdata = $treelist->GetItemData($tlroot);
    is( $$outdata, 'Hubris', "Wx::TreeListCtrl::GetItemData" );
    $outdata = $treelist->GetItemData($tlroot);
    is( $$outdata, 'Hubris', "Wx::TreeListCtrl::GetItemData again" );    
    
    $treelist->SetItemData($tlroot, Wx::TreeItemData->new( 'Aghast' ) );
    $outdata = $treelist->GetItemData($tlroot)->GetData;
    is( $outdata, 'Aghast', "Wx::TreeListCtrl::GetItemData From Wx::TreeItemData" );    
    
    ## test deleting and setting again
    my( $tldeleting, $tlsetting, $tlctrldelete ) = ( 0, 0, 0 );
        
    my $tlitem1 = $treelist->AppendItem( $tlroot, 'An item', -1, -1,
                                   cdata sub { $tldeleting = 1 } );
    my $tlitem2 = $treelist->AppendItem( $tlroot, 'An item', -1, -1,
                                   cdata sub { $tlsetting = 1 } );
    my $tlitem3 = $treelist->AppendItem( $tlroot, 'An item', -1, -1,
                                   cdata sub { $tlctrldelete = 1 } );
    
    is( ref($treelist->GetItemData($tlitem1)), 'MyClass', 'Wx::TreeListCtrl Item Data is class');
    
    $treelist->DeleteItem( $tlitem1 );
    
    ok( $tldeleting, 'Wx::TreeListCtrl: deleting an item deletes the data' );
    $treelist->SetItemData( $tlitem2, Wx::TreeItemData->new( 'foo' ) );
    ok( $tlsetting, 'Wx::TreeListCtrl: setting again item data deletes old data' );
    ## and hope the tree is deleted NOW
    $treelist->Destroy;
    ok( $tlctrldelete, 'Wx::TreeListCtrl: deleting the tree deletes the data' );
  };

  ############################################################################
  # wxListBox & co.
  ############################################################################

  my $list = Wx::ListBox->new( $this, -1 );
  my $combo = Wx::ComboBox->new( $this, -1, 'foo' );
  my $choice = Wx::Choice->new( $this, -1 );
  my $checklist = Wx::CheckListBox->new( $this, -1, [-1, -1], [-1, -1], [1] );
  my $odncombo = undef;

  if( defined &Wx::PlOwnerDrawnComboBox::new ) {
      $odncombo = Wx::PlOwnerDrawnComboBox->new( $this, -1, 'foo', [-1, -1],
                                                 [-1, -1], [] );
  }

  # test deleting and setting again
  for my $x ( [ $list, 'Wx::ListBox' ],
              [ $choice, 'Wx::Choice' ],
              [ $combo, 'Wx::ComboBox' ],
              [ $checklist, 'Wx::CheckListBox' ],
              [ $odncombo, 'Wx::OwnerDrawnComboBox' ],
              ) {
    SKIP: {
      my( $list, $name ) = @$x;
      ( $deleting, $setting, $ctrldelete ) = ( 0, 0, 0 );

      skip( $x->[1] . ": not available", 8 )
        if !defined $x->[0];
      skip( "wxMSW wxCheckListBox can't store client data yet", 8 )
        if Wx::wxMSW && $name eq 'Wx::CheckListBox';

      $list->Clear;

      # diag "starting tests for $name";
      my $data = 'Foo';

      $list->Append( 'An item', $data );
      $list->SetClientData( 0, $data ); # workaround bug in HEAD
      $list->Append( 'An item' );

      $data = 'Frobnication';

      is( $list->GetClientData( 0 ), 'Foo', "$name: some client data" );
      is( $list->GetClientData( 1 ), undef, "$name: no client data" );
      $list->SetClientData( 0, 'Bar' );
      $list->SetClientData( 1, 'Baz' );
      is( $list->GetClientData( 0 ), 'Bar', "$name: setting client data" );
      is( $list->GetClientData( 1 ), 'Baz',
          "$name: setting client data (again)" );

      my $x = 1;
      $list->SetClientData( 0, \$x );
      $x = 2;
      is( ${$list->GetClientData( 0 )}, 2,
          "$name: client data is a reference" );

      $list->Append( 'An item', cdata sub { $setting = 1 } );
      $list->Append( 'An item', cdata sub { $ctrldelete = 1 } );
      $list->Append( 'An item', cdata sub { $deleting = 1 } );

      SKIP: {
        skip "delayed on Mac", 1 if Wx::wxMAC && $list->isa( 'Wx::ListBox' );
        $list->Delete( 4 );
        ok( $deleting, "$name: deleting an item deletes the data" );
      }
      $list->SetClientData( 2, 'foo' );
      ok( $setting, "$name: setting again item data deletes old data" );
      # and hope the control is deleted NOW
      $list->Destroy;
      
      TODO: {
        local $TODO = "is it correct to skip as below ? - Fails on osx-cocoa & 2.9.2 all platforms?";
        # skip "delete delayed", 1 if ( $list->isa( 'Wx::ListBox' ) || $list->isa( 'Wx::ComboBox' ) || $list->isa( 'Wx::Choice' ) );
        ok( $ctrldelete, "$name: deleting the control deletes the data" );
      };
    }
  }

  ############################################################################
  # wxListCtrl
  ############################################################################

  my $listctrl = Wx::ListCtrl->new( $this, -1, [-1, -1], [-1, -1],
                                    Wx::wxLC_REPORT() );
  $listctrl->InsertColumn( 1, "Type" );

  $listctrl->InsertStringItem( 0, 'text0' );
  $listctrl->InsertStringItem( 1, 'text1' );
  $listctrl->InsertStringItem( 2, 'text2' );

  $listctrl->SetItemData( 0, 123 );
  $listctrl->SetItemData( 1, 456 );
  $listctrl->SetItemData( 2, 789 );

  is( $listctrl->GetItemData( 0 ), 123, "Wx::ListCtrl first item data" );
  is( $listctrl->GetItemData( 1 ), 456, "Wx::ListCtrl second item data" );
  is( $listctrl->GetItemData( 2 ), 789, "Wx::ListCtrl third item data" );

  $listctrl->SetItemData( 1, 135 );

  is( $listctrl->GetItemData( 1 ), 135, "Wx::ListCtrl, changing item data" );
  
  ############################################################################
  # wxToolBar
  ############################################################################
  my $toolbar = Wx::ToolBar->new( $this, -1);
  my $tool = $toolbar->AddTool(Wx::wxID_ANY(), Wx::Bitmap->new(16,16,1));
  $tool = $toolbar->AddTool(Wx::wxID_ANY(), Wx::Bitmap->new(16,16,1));
  my $toolid = $tool->GetId;
  isnt($toolid, -1, 'Wx::ToolBar got valid tool id');
  $toolbar->SetToolClientData( $toolid, 'Bar' );
  is( $toolbar->GetToolClientData( $toolid ), 'Bar', 'Wx::ToolBar client data set');
  $toolbar->Realize;
  $ctrldelete = 0;
  $toolbar->SetToolClientData( $toolid, cdata( sub { $ctrldelete = 1 } ));
  
  ok( $ctrldelete == 0, 'Wx::ToolBar controldata not deleted' );
  $toolbar->SetToolClientData( $toolid, undef );
  ok( $ctrldelete, 'Wx::ToolBar - setting client data causes previous data deletion' );

}

in_frame( \&tests );

# local variables:
# mode: cperl
# end: