/t/sdlx_validate.t
Unknown | 126 lines | 112 code | 14 blank | 0 comment | 0 complexity | 9094648fd81fafb7ba71801b19b30ecf MD5 | raw file
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;