summaryrefslogtreecommitdiff
path: root/os2/OS2/Process/t
diff options
context:
space:
mode:
Diffstat (limited to 'os2/OS2/Process/t')
-rw-r--r--os2/OS2/Process/t/os2_atoms.t88
-rw-r--r--os2/OS2/Process/t/os2_clipboard.t211
-rw-r--r--os2/OS2/Process/t/os2_process.t24
3 files changed, 317 insertions, 6 deletions
diff --git a/os2/OS2/Process/t/os2_atoms.t b/os2/OS2/Process/t/os2_atoms.t
new file mode 100644
index 0000000000..5d9603f2c9
--- /dev/null
+++ b/os2/OS2/Process/t/os2_atoms.t
@@ -0,0 +1,88 @@
+#! /usr/bin/perl -w
+
+use strict;
+use Test::More tests => 48;
+BEGIN {use_ok 'OS2::Process'}
+
+ok(SystemAtomTable(), 'SystemAtomTable succeeds');
+my $tbl = CreateAtomTable;
+
+ok($tbl, 'CreateAtomTable succeeds');
+
+is(AtomLength(133, $tbl), 6, 'AtomLength of unknown atom is 6');
+is(AtomLength(1, $tbl), 6, 'AtomLength of unknown atom is 6');
+ok(!defined eval {AtomLength(100000, $tbl); 1}, 'AtomLength of invalid atom croaks');
+# diag($@);
+
+is(AtomUsage(134, $tbl), 65535, 'AtomUsage of unknown atom is 65535');
+is(AtomUsage(1, $tbl), 65535, 'AtomUsage of unknown atom is 65535');
+ok(!defined eval {AtomUsage(100000, $tbl); 1}, 'AtomUsage of invalid atom croaks');
+# diag($@);
+
+is(AtomName(134, $tbl), '#134', 'AtomName of unknown atom is #number');
+is(AtomName(2, $tbl), '#2', 'AtomName of unknown atom is #number');
+ok(!defined eval {AtomName(100000, $tbl); 1}, 'AtomName of invalid atom croaks');
+# diag($@);
+
+is(FindAtom('#134', $tbl), 134, 'Name of unknown atom per #number');
+is(FindAtom('#2', $tbl), 2, 'Name of unknown atom per #number');
+ok(!defined eval {FindAtom('#90000', $tbl); 1}, 'Finding invalid numeric atom croaks');
+# diag($@);
+ok(!defined eval {FindAtom('2#', $tbl); 1}, 'Finding invalid atom croaks');
+# diag($@);
+ok(!defined eval {FindAtom('texxt/unnknnown', $tbl); 1}, 'Finding invalid atom croaks');
+# diag($@);
+
+is(DeleteAtom(125000, $tbl), '', 'Deleting invalid atom returns FALSE');
+is(DeleteAtom(10000, $tbl), 1, 'Deleting unknown atom returns 1');
+ok(!defined eval {DeleteAtom(0, $tbl); 1}, 'Deleting zero atom croaks');
+# diag($@);
+
+is(AddAtom('#134', $tbl), 134, 'Add unknown atom per #number');
+is(AddAtom('#2', $tbl), 2, 'Add unknown atom per #number');
+ok(!defined eval {AddAtom('#80000', $tbl); 1}, 'Add invalid numeric atom croaks');
+# diag($@);
+
+my $a1 = AddAtom("perltest//pp$$", $tbl);
+ok($a1, 'Add unknown atom per string');
+my $a2 = AddAtom("perltest//p$$", $tbl);
+ok($a2, 'Add another unknown atom per string');
+is(AddAtom("perltest//p$$", $tbl), $a2, 'Add same unknown atom per string');
+isnt($a1, $a2, 'Different strings result in different atoms');
+ok($a1 > 0, 'Atom positive');
+ok($a2 > 0, 'Another atom positive');
+ok($a1 < 0x10000, 'Atom small');
+ok($a2 < 0x10000, 'Another atom small');
+
+is(AtomLength($a1, $tbl), length "perltest//pp$$", 'AtomLength of known atom');
+is(AtomLength($a2, $tbl), length "perltest//p$$", 'AtomLength of another known atom');
+
+is(AtomUsage($a1, $tbl), 1, 'AtomUsage of known atom');
+is(AtomUsage($a2, $tbl), 2, 'AtomUsage of another known atom');
+
+is(AtomName($a1, $tbl), "perltest//pp$$", 'AtomName of known atom');
+is(AtomName($a2, $tbl), "perltest//p$$", 'AtomName of another known atom');
+
+is(FindAtom("perltest//pp$$", $tbl), $a1, 'Name of known atom');
+is(FindAtom("perltest//p$$", $tbl), $a2, 'Name of known atom');
+
+#$^E = 0;
+ok(DeleteAtom($a1, $tbl), 'DeleteAtom of known atom');
+#diag("err=$^E");
+#$^E = 0;
+ok(DeleteAtom($a2, $tbl), 'DeleteAtom of another known atom');
+#diag("err=$^E");
+
+ok(!defined eval {AtomUsage($a1, $tbl); 1}, 'AtomUsage of deleted known atom croaks');
+# diag($@);
+is(AtomUsage($a2, $tbl), 1, 'AtomUsage of another known atom');
+
+ok(!defined eval {AtomName($a1, $tbl); 1}, 'AtomName of deleted known atom croaks');
+# diag($@);
+is(AtomName($a2, $tbl), "perltest//p$$", 'AtomName of undeleted another known atom');
+
+ok(!defined eval {FindAtom("perltest//pp$$", $tbl); 1}, 'Finding known deleted atom croaks');
+# diag($@);
+is(FindAtom("perltest//p$$", $tbl), $a2, 'Finding known undeleted atom');
+
+ok(DestroyAtomTable($tbl), 'DestroyAtomTable succeeds');
diff --git a/os2/OS2/Process/t/os2_clipboard.t b/os2/OS2/Process/t/os2_clipboard.t
new file mode 100644
index 0000000000..398a5fee7d
--- /dev/null
+++ b/os2/OS2/Process/t/os2_clipboard.t
@@ -0,0 +1,211 @@
+#! /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");
+
diff --git a/os2/OS2/Process/t/os2_process.t b/os2/OS2/Process/t/os2_process.t
index 123525dd4d..18d8fe2a11 100644
--- a/os2/OS2/Process/t/os2_process.t
+++ b/os2/OS2/Process/t/os2_process.t
@@ -24,7 +24,7 @@ BEGIN { # Remap I/O to the parent's window
}
use strict;
-use Test::More tests => 232;
+use Test::More tests => 235;
use OS2::Process;
sub SWP_flags ($) {
@@ -218,18 +218,28 @@ is($fhwnd, $ahwnd, 'the focus window = the active window');
ok hWindowPos_set({behind => 3}, $k_hwnd), # HWND_TOP
'put kid to the front';
-is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front');
+# After Alt-Tab a WS_TOPMOST, WS_DISABLED window of class 'AltTabWindow' exists
+my $top = (hWindowPos $k_hwnd)->{behind};
+ok(($top == 3 or WindowStyle($top) & 0x200000), # HWND_TOP, WS_TOPMOST
+ 'kid is at front');
+# is((hWindowPos $k_hwnd)->{behind}, 3, 'kid is at front');
-my ($enum_handle, $first_zorder);
+my ($enum_handle, $first_zorder, $first_non_TOPMOST);
{ my $force_PM = OS2::localMorphPM->new(0);
ok $force_PM, 'morphed to PM locally again';
$enum_handle = BeginEnumWindows 1; # HWND_DESKTOP
ok $enum_handle, 'start enumeration';
- $first_zorder = GetNextWindow $enum_handle;
+ $first_non_TOPMOST = $first_zorder = GetNextWindow $enum_handle;
ok $first_zorder, 'GetNextWindow works';
+ my $f = WindowStyle $first_non_TOPMOST;
+ ok $f, 'WindowStyle works';
+ $f = WindowStyle($first_non_TOPMOST = GetNextWindow $enum_handle)
+ while $f & 0x200000; # WS_TOPMOST
+ ok($first_non_TOPMOST, 'There is non-TOPMOST window');
+ ok(!(WindowStyle($first_non_TOPMOST) & 0x200000), 'Indeed non-TOPMOST');
ok EndEnumWindows($enum_handle), 'end enumeration';
}
-is ($first_zorder, $k_hwnd, 'kid is the first in z-order enumeration');
+is ($first_non_TOPMOST, $k_hwnd, 'kid is the first in z-order enumeration');
ok hWindowPos_set({behind => 4}, $k_hwnd), # HWND_BOTTOM
'put kid to the back';
@@ -262,7 +272,9 @@ is $list[-2], $k_hwnd, 'kid is the last but one in ChildWindows';
ok hWindowPos_set({behind => 3}, $k_hwnd), # HWND_TOP
'put kid to the front again';
-is((hWindowPos $k_hwnd)->{behind}, 3, 'kis is at front again');
+$top = (hWindowPos $k_hwnd)->{behind};
+ok(($top == 3 or WindowStyle($top) & 0x200000), # WS_TOPMOST
+ 'kid is at front again');
sleep 5 if $interactive_wait;
ok IsWindow($k_hwnd), 'IsWindow works';
View Lorry Controller Status