/t/sdlx_validate.t

  1use strict;
  2use warnings;
  3use Test::More;
  4use SDL;
  5use SDL::Video;
  6use SDLx::Surface;
  7use SDLx::Validate; #use_ok is checked in t/00-load.t
  8use lib 't/lib';
  9use SDL::TestTool;
 10
 11my $videodriver = $ENV{SDL_VIDEODRIVER};
 12$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 13
 14if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
 15	plan( skip_all => 'Failed to init video' );
 16}
 17
 18my $app = SDL::Video::set_video_mode( 400, 200, 32, SDL_SWSURFACE );
 19
 20can_ok(
 21	'SDLx::Validate',
 22	qw( surface rect num_rgb num_rgba list_rgb list_rgba color )
 23);
 24
 25my @surfaces = (
 26	'SDL::Surface->new(0, 1, 2, 32, 0, 0, 0, 0)',
 27	'SDLx::Surface->new(w => 1, h => 2)',
 28);
 29for (@surfaces) {
 30	ok( SDLx::Validate::surface(eval)->isa("SDL::Surface"),
 31		"surface($_) is a SDL::Surface"
 32	);
 33}
 34eval { SDLx::Validate::surface( SDL::Rect->new( 0, 0, 0, 0 ) ) };
 35is( $@ =~ /Surface must be SDL::Surface or SDLx::Surface/, 1, "Validate detects wrong objects" );
 36
 37my @rects_0 = ( '[]', '[0, 0, 0, 0]', 'SDL::Rect->new(0, 0, 0, 0)', );
 38for (@rects_0) {
 39	my $r = SDLx::Validate::rect(eval);
 40	is_deeply(
 41		[ $r->x, $r->y, $r->w, $r->h ],
 42		[ 0,     0,     0,     0 ],
 43		"rect($_) is (0, 0, 0, 0)"
 44	);
 45}
 46
 47my @rects_positive = ( '[1, 2, 3, 4]', 'SDL::Rect->new(1, 2, 3, 4)', );
 48for (@rects_positive) {
 49	my $r = SDLx::Validate::rect(eval);
 50	is_deeply(
 51		[ $r->x, $r->y, $r->w, $r->h ],
 52		[ 1,     2,     3,     4 ],
 53		"rect($_) is (1, 2, 3, 4)"
 54	);
 55}
 56
 57my $format       = $app->format;
 58my $mapped_black = SDL::Video::map_RGBA( $format, 0x00, 0x00, 0x00, 0xFF );
 59my $mapped_white = SDL::Video::map_RGBA( $format, 0xFF, 0xFE, 0xFD, 0xFF );
 60
 61my @blacks_rgb = ( 'undef', 0, '[0, 0, 0]', '[]', 'SDL::Color->new(0, 0, 0)', );
 62for (@blacks_rgb) {
 63	is( SDLx::Validate::num_rgb(eval), 0, "num_rgb($_) is 0x000000" );
 64	is_deeply(
 65		SDLx::Validate::list_rgb(eval),
 66		[ 0, 0, 0 ],
 67		"list_rgb($_) is [0, 0, 0]"
 68	);
 69	is( SDLx::Validate::map_rgb( eval, $format ), $mapped_black, "map_rgb($_, $format) is $mapped_black" );
 70	my $c = SDLx::Validate::color(eval);
 71	is_deeply( [ $c->r, $c->g, $c->b ], [ 0, 0, 0 ], "color($_) is (0, 0, 0)" );
 72}
 73
 74my @whites_rgb = ( '0xFFFEFD', '[0xFF, 0xFE, 0xFD]', 'SDL::Color->new(0xFF, 0xFE, 0xFD)', );
 75for (@whites_rgb) {
 76	is( SDLx::Validate::num_rgb(eval), 0xFFFEFD, "num_rgb($_) is 0xFFFEFD" );
 77	is_deeply(
 78		SDLx::Validate::list_rgb(eval),
 79		[ 0xFF, 0xFE, 0xFD ],
 80		"list_rgb($_) is [0xFF, 0xFE, 0xFD]"
 81	);
 82	is( SDLx::Validate::map_rgb( eval, $format ), $mapped_white, "map_rgb($_, $format) is $mapped_white" );
 83	my $c = SDLx::Validate::color(eval);
 84	is_deeply(
 85		[ $c->r, $c->g, $c->b ],
 86		[ 0xFF,  0xFE,  0xFD ],
 87		"color($_) is (0xFF, 0xFE, 0xFD)"
 88	);
 89}
 90
 91my @blacks_rgba = (
 92	'undef',     '0x000000FF',
 93	'[0, 0, 0]', '[undef, undef, undef, 0xFF]',
 94	'[]',        'SDL::Color->new(0, 0, 0)',
 95);
 96for (@blacks_rgba) {
 97	is( SDLx::Validate::num_rgba(eval), 0xFF, "num_rgba($_) is 0x000000FF" );
 98	is_deeply(
 99		SDLx::Validate::list_rgba(eval),
100		[ 0, 0, 0, 0xFF ],
101		"list_rgba($_) is [0, 0, 0, 0xFF]"
102	);
103	is( SDLx::Validate::map_rgba( eval, $format ), $mapped_black, "map_rgba($_, $format) is $mapped_black" );
104}
105
106my @whites_rgba = (
107	'0xFFFEFDFF',
108	'[0xFF, 0xFE, 0xFD]',
109	'[0xFF, 0xFE, 0xFD, 0xFF]',
110	'SDL::Color->new(0xFF, 0xFE, 0xFD)',
111);
112for (@whites_rgba) {
113	is( SDLx::Validate::num_rgba(eval),
114		0xFFFEFDFF, "num_rgba($_) is 0xFFFEFDFF"
115	);
116	is_deeply(
117		SDLx::Validate::list_rgba(eval),
118		[ 0xFF, 0xFE, 0xFD, 0xFF ],
119		"list_rgba($_) is [0xFF, 0xFE, 0xFD, 0xFF]"
120	);
121	is( SDLx::Validate::map_rgba( eval, $format ), $mapped_white, "map_rgba($_, $format) is $mapped_white" );
122}
123
124isnt( SDLx::Validate::num_rgba(0), 0xFF, "num_rgba(0) isn't 0x000000FF" );
125
126done_testing;