The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -wT
# Win32::GUI test suite.
# $Id: 04_cov.t,v 1.3 2006/05/16 18:57:26 robertemay Exp $
#
# test coverage of most AddCtrl, new Ctrl and DESTROY methods

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

use Test::More qw(no_plan);

use Win32::GUI();

my @ControlsAdd =
  qw/Animation
     Button Checkbox Combobox ComboboxEx
     DateTime Graphic
     Groupbox Header Label
     ListView Listbox
     Menu MonthCal 
     ProgressBar RadioButton Rebar
     RichEdit Slider Splitter StatusBar
     TabStrip Textfield Toolbar
     Trackbar TreeView UpDown/;

# TODO: Win32::GUI::MDIFrame->Add...
# MDIClient, ...

# Need special tests:
my @ControlsNewSpecial =
  qw(AcceleratorTable ImageList Region Icon
     MenuButton MenuItem
     Brush Cursor DC DialogBox Font
     Header Label Menu MDIChild
     MDIClient MDIFrame
     MonthCal NotifyIcon Pen
     Timer Window);

my $W = new Win32::GUI::Window(
    -name => "TestWindow",
    -pos  => [  0,   0],
    -size => [800, 600],
    -text => "TestWindow",
);
isa_ok($W, "Win32::GUI::Window");

for my $ctrl (@ControlsAdd) {
  #no strict 'refs';
  my $method = "Add$ctrl";
  my $name = "Test$ctrl";
  my $C = $W->$method(-name => $name);
  isa_ok($C,          "Win32::GUI::$ctrl", "\$W->$method") unless $ctrl =~ /Menu/;
  isa_ok($W->{$name}, "Win32::GUI::$ctrl", "\$W->{$name}") unless $ctrl =~ /Menu/;
  is($C, $W->{$name}, "Parent references $ctrl")           unless $ctrl =~ /Menu/;
  $C->DESTROY();
  ok(!defined $W->{$name}, "$name->DESTROY()") unless $ctrl =~ /NotifyIcon/;
}
exit(0);
# The same ctrls: requiring $W (PARENT) as first arg:
for my $ctrl (@ControlsAdd) {
  #no strict 'refs';
  next if $ctrl =~ /Menu/;
  my $class = "Win32::GUI::$ctrl";
  my $name = "Test$ctrl";
  my $C = new $class($W, -name => $name);
  isa_ok($C,          $class, "new $class(\$W)");
  isa_ok($W->{$name}, $class, "\$W->{$name}");
  is($C, $W->{$name}, "Parent references $ctrl");
  $C->DESTROY();
  ok(!defined $W->{$name}, "$name->DESTROY()") unless $ctrl =~ /NotifyIcon/;
}