PageRenderTime 14ms CodeModel.GetById 5ms RepoModel.GetById 0ms app.codeStats 0ms

/t/sdlx_validate.t

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