The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
# Win32::GUI::DropFiles test suite
# $Id: 06_GetDropPos.t,v 1.2 2006/05/16 18:57:26 robertemay Exp $
#
# Test Win32::GUI::DropFiles GetDropPos() method

use strict;
use warnings;

BEGIN { $| = 1 } # Autoflush

# We assume that 01_load.t has been run, so we know we have Test::More
# and that Win32::GUI and Win32::GUI::DropFiles will load.

use Test::More;
 
BEGIN {
    eval "use Win32::API 0.41";
    plan skip_all => "Win32::API 0.41 required for testing GetDropPos()" if $@;
}

# Load our helpers
use FindBin;
use lib "$FindBin::Bin";
use DropTest;

use Win32::GUI 1.03_02,'';
use Win32::GUI::DropFiles;

my @testdata = (
  { x => 100, y => 120, c => 1 },
  { x => 1,   y => -1,  c => 0 },
);
my $numtests = scalar @testdata;

plan tests => 6 * $numtests;

my $W = Win32::GUI::Window->new(
    -name  => 'win',
    -title => "Win32::GUI DropFiles Test",
    -size  => [400,300],
    -onDropFiles => \&drop,
);

Win32::GUI::DoEvents();

my $testnum;
for (0..$numtests-1) {
    $testnum = $_;
    my $dropobj = DropTest->new(
        x => $testdata[$testnum]->{x},
        y => $testdata[$testnum]->{y},
        client => $testdata[$testnum]->{c},
    );
    $dropobj->PostDropMessage($W);
    Win32::GUI::Dialog();
}
exit(0);

sub drop {
    my ($self, $dropobj) = @_;

    # GetDropPos in scalar context returns client area or not
    is($dropobj->GetDropPos(), $testdata[$testnum]->{c}, "Correct client indication");

    # In list context give x, y and client indicators:
    { my ($x, $y) = $dropobj->GetDropPos();
      is($x, $testdata[$testnum]->{x}, "X-pos reported correctly");
      is($y, $testdata[$testnum]->{y}, "Y-pos reported correctly");
    }
    { my ($x, $y, $client) = $dropobj->GetDropPos();
      is($x, $testdata[$testnum]->{x}, "X-pos reported correctly");
      is($y, $testdata[$testnum]->{y}, "Y-pos reported correctly");
      is($client, $testdata[$testnum]->{c}, "client pos reported correctly");
    }
    
    return -1;
}