#! /usr/bin/perl -w use strict; use Test::More tests => 87; BEGIN {use_ok 'OS2::Process', qw(:DEFAULT CFI_POINTER CF_TEXT)} # Initialize my $raw = "Just a random\nselection"; (my $cr = $raw) =~ s/\n/\r\n/g; ok(ClipbrdText_set($raw), 'ClipbrdText_set'); my ($v, $p, @f); is(ClipbrdText, $cr, "ClipbrdText it back"); is(ClipbrdOwner, 0, "ClipbrdOwner is not defined"); $v = ClipbrdViewer; ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window"); { my $h = OS2::localClipbrd->new; $p = ClipbrdData; @f = MemoryRegionSize($p, 0x4000); # 4 pages, 16K, limit is(scalar @f, 2, 'MemoryRegionSize(16K) returns 2 values'); # diag(sprintf '%#x, %#x, %#x, %#x', @f, $f[0]+$p, $p); is($f[0], 4096, 'MemoryRegionSize claims 1 page is available'); ok($f[1] & 0x1, 'MemoryRegionSize claims page readable');# PAG_READ=1 0x12013 my @f1 = MemoryRegionSize($p, 0x100000); # 16 blocks, 1M, limit is(scalar @f1, 2, 'MemoryRegionSize(1M) returns 2 values'); is($f1[0], $f[0], 'MemoryRegionSize returns same length'); is($f1[1], $f[1], 'MemoryRegionSize returns same flags'); @f1 = MemoryRegionSize($p); is(scalar @f1, 2, 'MemoryRegionSize(no-limit) returns 2 values'); is($f1[0], $f[0], 'MemoryRegionSize returns same length'); is($f1[1], $f[1], 'MemoryRegionSize returns same flags'); } ok($p, 'ClipbrdData'); is(ClipbrdFmtInfo, CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); # CF_TEXT is 1 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); @f = ClipbrdFmtAtoms; is(scalar @f, 1, "Only one format available"); is($f[0], CF_TEXT, "format is CF_TEXT"); @f = ClipbrdFmtNames; is(scalar @f, 1, "Only one format available"); is($f[0], '#1', "format is CF_TEXT='#1'"); { my $h = OS2::localClipbrd->new; ok(EmptyClipbrd, 'EmptyClipbrd'); } @f = ClipbrdFmtNames; is(scalar @f, 0, "No format available"); undef $p; undef $v; eval { my $h = OS2::localClipbrd->new; $p = ClipbrdData; $v = 1; }; ok(! defined $p, 'ClipbrdData croaked'); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); ok(! defined eval {ClipbrdText}, "ClipbrdText croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); # CF_TEXT is 1 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); is(ClipbrdOwner, 0, "ClipbrdOwner is not defined"); $v = ClipbrdViewer; ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window"); is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0'); @f = ClipbrdFmtAtoms; is(scalar @f, 0, "No formats available"); { my $h = OS2::localClipbrd->new; ok(EmptyClipbrd, 'EmptyClipbrd when clipboard is empty succeeds'); } ok(ClipbrdText_set($raw, 1), 'ClipbrdText_set() raw'); is(ClipbrdText, $raw, "ClipbrdText it back"); { my $h = OS2::localClipbrd->new; ok(EmptyClipbrd, 'EmptyClipbrd again'); } my $ar = AddAtom 'perltest/unknown_raw'; ok($ar, 'Atom added'); my $ar1 = AddAtom 'perltest/unknown_raw1'; ok($ar1, 'Atom added'); my $a = AddAtom 'perltest/unknown'; ok($a, 'Atom added'); my $a1 = AddAtom 'perltest/unknown1'; ok($a1, 'Atom added'); { my $h = OS2::localClipbrd->new; ok(ClipbrdData_set($raw), 'ClipbrdData_set()'); ok(ClipbrdData_set($raw, 0, $ar1), 'ClipbrdData_set(perltest/unknown_raw1)'); ok(ClipbrdData_set($cr, 0, $ar), 'ClipbrdData_set(perltest/unknown_raw)'); ok(ClipbrdData_set($raw, 1, $a1), 'ClipbrdData_set(perltest/unknown1)'); ok(ClipbrdData_set($cr, 1, $a), 'ClipbrdData_set(perltest/unknown)'); # Results should be the same, except ($raw, 0) one... } is(ClipbrdText, $cr, "ClipbrdText CF_TEXT back"); is(ClipbrdText($ar1), $raw, "ClipbrdText perltest/unknown_raw1 back"); is(ClipbrdText($ar), $cr, "ClipbrdText perltest/unknown_raw back"); is(ClipbrdText($a1), $cr, "ClipbrdText perltest/unknown1 back"); is(ClipbrdText($a), $cr, "ClipbrdText perltest/unknown back"); is(ClipbrdFmtInfo, CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); is(ClipbrdFmtInfo($ar1), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); is(ClipbrdFmtInfo($ar), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); is(ClipbrdFmtInfo($a1), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); is(ClipbrdFmtInfo($a), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); # CF_TEXT is 1 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); my $names = join ',', sort '#1', qw(perltest/unknown perltest/unknown1 perltest/unknown_raw perltest/unknown_raw1); @f = ClipbrdFmtAtoms; is(scalar @f, 5, "5 formats available"); is((join ',', sort map AtomName($_), @f), $names, "formats are $names"); @f = ClipbrdFmtNames; is(scalar @f, 5, "Only one format available"); is((join ',', sort @f), $names, "formats are $names"); { my $h = OS2::localClipbrd->new; ok(EmptyClipbrd, 'EmptyClipbrd'); } @f = ClipbrdFmtNames; is(scalar @f, 0, "No formats available"); { my $h = OS2::localClipbrd->new; ok(ClipbrdText_set($cr, 1, $ar), 'ClipbrdText_set(perltest/unknown_raw)'); }; #diag(join ' ', ClipbrdFmtNames); is(ClipbrdText($ar), $cr, "ClipbrdText perltest/unknown_raw back"); is(ClipbrdFmtInfo($ar), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER'); ok(!defined eval {ClipbrdText(CF_TEXT); 1}, "ClipbrdText(CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); # CF_TEXT is 1 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); @f = ClipbrdFmtNames; is(scalar @f, 1, "1 format available"); is($f[0], 'perltest/unknown_raw', "format is perltest/unknown_raw"); @f = ClipbrdFmtAtoms; is(scalar @f, 1, "1 format available"); is($f[0], $ar, "format is perltest/unknown_raw"); { my $h = OS2::localClipbrd->new; ok(EmptyClipbrd, 'EmptyClipbrd'); } undef $p; undef $v; eval { my $h = OS2::localClipbrd->new; $p = ClipbrdData; $v = 1; }; ok(! defined $p, 'ClipbrdData croaked'); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); ok(! defined eval {ClipbrdText}, "ClipbrdText croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); # CF_TEXT is 1 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks"); like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message'); is(ClipbrdOwner, 0, "ClipbrdOwner is not defined"); $v = ClipbrdViewer; ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window"); is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0'); @f = ClipbrdFmtAtoms; is(scalar @f, 0, "No formats available");