1#! /usr/bin/perl -w
2
3use strict;
4use Test::More tests => 87;
5BEGIN {use_ok 'OS2::Process', qw(:DEFAULT CFI_POINTER CF_TEXT)}
6
7# Initialize
8my $raw = "Just a random\nselection";
9(my $cr = $raw) =~ s/\n/\r\n/g;
10ok(ClipbrdText_set($raw), 'ClipbrdText_set');
11
12my ($v, $p, @f);
13is(ClipbrdText, $cr, "ClipbrdText it back");
14is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
15$v = ClipbrdViewer;
16ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
17
18{
19  my $h = OS2::localClipbrd->new;
20  $p = ClipbrdData;
21
22  @f = MemoryRegionSize($p, 0x4000);		# 4 pages, 16K, limit
23  is(scalar @f, 2, 'MemoryRegionSize(16K) returns 2 values');
24  # diag(sprintf '%#x, %#x, %#x, %#x', @f, $f[0]+$p, $p);
25  is($f[0], 4096, 'MemoryRegionSize claims 1 page is available');
26  ok($f[1] & 0x1, 'MemoryRegionSize claims page readable');# PAG_READ=1 0x12013
27
28  my @f1 = MemoryRegionSize($p, 0x100000);		# 16 blocks, 1M, limit
29  is(scalar @f1, 2, 'MemoryRegionSize(1M) returns 2 values');
30  is($f1[0], $f[0], 'MemoryRegionSize returns same length');
31  is($f1[1], $f[1], 'MemoryRegionSize returns same flags');
32
33  @f1 = MemoryRegionSize($p);
34  is(scalar @f1, 2, 'MemoryRegionSize(no-limit) returns 2 values');
35  is($f1[0], $f[0], 'MemoryRegionSize returns same length');
36  is($f1[1], $f[1], 'MemoryRegionSize returns same flags');
37}
38
39ok($p, 'ClipbrdData');
40
41is(ClipbrdFmtInfo, CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
42
43# CF_TEXT is 1
44ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
45like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
46
47@f = ClipbrdFmtAtoms;
48is(scalar @f, 1, "Only one format available");
49is($f[0], CF_TEXT, "format is CF_TEXT");
50
51@f = ClipbrdFmtNames;
52is(scalar @f, 1, "Only one format available");
53is($f[0], '#1', "format is CF_TEXT='#1'");
54
55{
56  my $h = OS2::localClipbrd->new;
57  ok(EmptyClipbrd, 'EmptyClipbrd');
58}
59
60@f = ClipbrdFmtNames;
61is(scalar @f, 0, "No format available");
62
63undef $p; undef $v;
64eval {
65  my $h = OS2::localClipbrd->new;
66  $p = ClipbrdData;
67  $v = 1;
68};
69
70ok(! defined $p, 'ClipbrdData croaked');
71like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
72
73ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
74like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
75
76# CF_TEXT is 1
77ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
78like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
79
80is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
81
82$v = ClipbrdViewer;
83ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
84
85is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
86
87@f = ClipbrdFmtAtoms;
88is(scalar @f, 0, "No formats available");
89
90{
91  my $h = OS2::localClipbrd->new;
92  ok(EmptyClipbrd, 'EmptyClipbrd when clipboard is empty succeeds');
93}
94
95ok(ClipbrdText_set($raw, 1), 'ClipbrdText_set() raw');
96is(ClipbrdText, $raw, "ClipbrdText it back");
97
98{
99  my $h = OS2::localClipbrd->new;
100  ok(EmptyClipbrd, 'EmptyClipbrd again');
101}
102
103my $ar = AddAtom 'perltest/unknown_raw';
104ok($ar, 'Atom added');
105my $ar1 = AddAtom 'perltest/unknown_raw1';
106ok($ar1, 'Atom added');
107my $a = AddAtom 'perltest/unknown';
108ok($a, 'Atom added');
109my $a1 = AddAtom 'perltest/unknown1';
110ok($a1, 'Atom added');
111
112{
113  my $h = OS2::localClipbrd->new;
114  ok(ClipbrdData_set($raw), 	     'ClipbrdData_set()');
115  ok(ClipbrdData_set($raw, 0, $ar1), 'ClipbrdData_set(perltest/unknown_raw1)');
116  ok(ClipbrdData_set($cr,  0, $ar),  'ClipbrdData_set(perltest/unknown_raw)');
117  ok(ClipbrdData_set($raw, 1, $a1),  'ClipbrdData_set(perltest/unknown1)');
118  ok(ClipbrdData_set($cr,  1, $a),   'ClipbrdData_set(perltest/unknown)');
119  # Results should be the same, except ($raw, 0) one...
120}
121
122is(ClipbrdText, $cr,	    "ClipbrdText CF_TEXT back");
123is(ClipbrdText($ar1), $raw, "ClipbrdText perltest/unknown_raw1 back");
124is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
125is(ClipbrdText($a1), $cr,   "ClipbrdText perltest/unknown1 back");
126is(ClipbrdText($a), $cr,    "ClipbrdText perltest/unknown back");
127
128is(ClipbrdFmtInfo,	 CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
129is(ClipbrdFmtInfo($ar1), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
130is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
131is(ClipbrdFmtInfo($a1),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
132is(ClipbrdFmtInfo($a),   CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
133
134# CF_TEXT is 1
135ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
136like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
137
138my $names = join ',', sort '#1', qw(perltest/unknown perltest/unknown1
139				    perltest/unknown_raw perltest/unknown_raw1);
140@f = ClipbrdFmtAtoms;
141is(scalar @f, 5, "5 formats available");
142is((join ',', sort map AtomName($_), @f), $names, "formats are $names");
143
144@f = ClipbrdFmtNames;
145is(scalar @f, 5, "Only one format available");
146is((join ',', sort @f), $names, "formats are $names");
147
148{
149  my $h = OS2::localClipbrd->new;
150  ok(EmptyClipbrd, 'EmptyClipbrd');
151}
152
153@f = ClipbrdFmtNames;
154is(scalar @f, 0, "No formats available");
155
156{
157  my $h = OS2::localClipbrd->new;
158  ok(ClipbrdText_set($cr,  1, $ar),  'ClipbrdText_set(perltest/unknown_raw)');
159};
160
161#diag(join ' ', ClipbrdFmtNames);
162
163is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
164is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
165
166ok(!defined eval {ClipbrdText(CF_TEXT); 1}, "ClipbrdText(CF_TEXT) croaks");
167like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
168# CF_TEXT is 1
169ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
170like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
171
172@f = ClipbrdFmtNames;
173is(scalar @f, 1, "1 format available");
174is($f[0], 'perltest/unknown_raw', "format is perltest/unknown_raw");
175
176@f = ClipbrdFmtAtoms;
177is(scalar @f, 1, "1 format available");
178is($f[0], $ar, "format is perltest/unknown_raw");
179
180{
181  my $h = OS2::localClipbrd->new;
182  ok(EmptyClipbrd, 'EmptyClipbrd');
183}
184
185undef $p; undef $v;
186eval {
187  my $h = OS2::localClipbrd->new;
188  $p = ClipbrdData;
189  $v = 1;
190};
191
192ok(! defined $p, 'ClipbrdData croaked');
193like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
194
195ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
196like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
197
198# CF_TEXT is 1
199ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
200like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
201
202is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
203
204$v = ClipbrdViewer;
205ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
206
207is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
208
209@f = ClipbrdFmtAtoms;
210is(scalar @f, 0, "No formats available");
211
212