os2/OS2/Process/t/os2_clipboard.t

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More tests => 87;
   5 BEGIN {use_ok 'OS2::Process', qw(:DEFAULT CFI_POINTER CF_TEXT)}
   6
   7 # Initialize
   8 my $raw = "Just a random\nselection";
   9 (my $cr = $raw) =~ s/\n/\r\n/g;
  10 ok(ClipbrdText_set($raw), 'ClipbrdText_set');
  11
  12 my ($v, $p, @f);
  13 is(ClipbrdText, $cr, "ClipbrdText it back");
  14 is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
  15 $v = ClipbrdViewer;
  16 ok((!$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
  39 ok($p, 'ClipbrdData');
  40
  41 is(ClipbrdFmtInfo, CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
  42
  43 # CF_TEXT is 1
  44 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
  45 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
  46
  47 @f = ClipbrdFmtAtoms;
  48 is(scalar @f, 1, "Only one format available");
  49 is($f[0], CF_TEXT, "format is CF_TEXT");
  50
  51 @f = ClipbrdFmtNames;
  52 is(scalar @f, 1, "Only one format available");
  53 is($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;
  61 is(scalar @f, 0, "No format available");
  62
  63 undef $p; undef $v;
  64 eval {
  65   my $h = OS2::localClipbrd->new;
  66   $p = ClipbrdData;
  67   $v = 1;
  68 };
  69
  70 ok(! defined $p, 'ClipbrdData croaked');
  71 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
  72
  73 ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
  74 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
  75
  76 # CF_TEXT is 1
  77 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
  78 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
  79
  80 is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
  81
  82 $v = ClipbrdViewer;
  83 ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
  84
  85 is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
  86
  87 @f = ClipbrdFmtAtoms;
  88 is(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
  95 ok(ClipbrdText_set($raw, 1), 'ClipbrdText_set() raw');
  96 is(ClipbrdText, $raw, "ClipbrdText it back");
  97
  98 {
  99   my $h = OS2::localClipbrd->new;
 100   ok(EmptyClipbrd, 'EmptyClipbrd again');
 101 }
 102
 103 my $ar = AddAtom 'perltest/unknown_raw';
 104 ok($ar, 'Atom added');
 105 my $ar1 = AddAtom 'perltest/unknown_raw1';
 106 ok($ar1, 'Atom added');
 107 my $a = AddAtom 'perltest/unknown';
 108 ok($a, 'Atom added');
 109 my $a1 = AddAtom 'perltest/unknown1';
 110 ok($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
 122 is(ClipbrdText, $cr,        "ClipbrdText CF_TEXT back");
 123 is(ClipbrdText($ar1), $raw, "ClipbrdText perltest/unknown_raw1 back");
 124 is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
 125 is(ClipbrdText($a1), $cr,   "ClipbrdText perltest/unknown1 back");
 126 is(ClipbrdText($a), $cr,    "ClipbrdText perltest/unknown back");
 127
 128 is(ClipbrdFmtInfo,       CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 129 is(ClipbrdFmtInfo($ar1), CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 130 is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 131 is(ClipbrdFmtInfo($a1),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 132 is(ClipbrdFmtInfo($a),   CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 133
 134 # CF_TEXT is 1
 135 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
 136 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 137
 138 my $names = join ',', sort '#1', qw(perltest/unknown perltest/unknown1
 139                                     perltest/unknown_raw perltest/unknown_raw1);
 140 @f = ClipbrdFmtAtoms;
 141 is(scalar @f, 5, "5 formats available");
 142 is((join ',', sort map AtomName($_), @f), $names, "formats are $names");
 143
 144 @f = ClipbrdFmtNames;
 145 is(scalar @f, 5, "Only one format available");
 146 is((join ',', sort @f), $names, "formats are $names");
 147
 148 {
 149   my $h = OS2::localClipbrd->new;
 150   ok(EmptyClipbrd, 'EmptyClipbrd');
 151 }
 152
 153 @f = ClipbrdFmtNames;
 154 is(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
 163 is(ClipbrdText($ar), $cr,   "ClipbrdText perltest/unknown_raw back");
 164 is(ClipbrdFmtInfo($ar),  CFI_POINTER, 'ClipbrdFmtInfo is CFI_POINTER');
 165
 166 ok(!defined eval {ClipbrdText(CF_TEXT); 1}, "ClipbrdText(CF_TEXT) croaks");
 167 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 168 # CF_TEXT is 1
 169 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(1+CF_TEXT) croaks");
 170 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 171
 172 @f = ClipbrdFmtNames;
 173 is(scalar @f, 1, "1 format available");
 174 is($f[0], 'perltest/unknown_raw', "format is perltest/unknown_raw");
 175
 176 @f = ClipbrdFmtAtoms;
 177 is(scalar @f, 1, "1 format available");
 178 is($f[0], $ar, "format is perltest/unknown_raw");
 179
 180 {
 181   my $h = OS2::localClipbrd->new;
 182   ok(EmptyClipbrd, 'EmptyClipbrd');
 183 }
 184
 185 undef $p; undef $v;
 186 eval {
 187   my $h = OS2::localClipbrd->new;
 188   $p = ClipbrdData;
 189   $v = 1;
 190 };
 191
 192 ok(! defined $p, 'ClipbrdData croaked');
 193 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 194
 195 ok(! defined eval {ClipbrdText}, "ClipbrdText croaks");
 196 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 197
 198 # CF_TEXT is 1
 199 ok(!defined eval {ClipbrdText(1+CF_TEXT); 1}, "ClipbrdText(not CF_TEXT) croaks");
 200 like($@, qr/\bPMERR_INVALID_HWND\b/, 'with expected (lousy) error message');
 201
 202 is(ClipbrdOwner, 0, "ClipbrdOwner is not defined");
 203
 204 $v = ClipbrdViewer;
 205 ok((!$v || IsWindow $v), "ClipbrdViewer is not defined or a valid window");
 206
 207 is(ClipbrdFmtInfo, 0, 'ClipbrdFmtInfo is 0');
 208
 209 @f = ClipbrdFmtAtoms;
 210 is(scalar @f, 0, "No formats available");
 211