/t/smpeg.t

http://github.com/PerlGameDev/SDL · Perl · 122 lines · 84 code · 19 blank · 19 comment · 5 complexity · f15b40511bf89a0d91241ba3117be6b6 MD5 · raw file

  1. #!perl
  2. # basic testing of SDL::SMPEG
  3. BEGIN {
  4. unshift @INC, 'blib/lib', 'blib/arch';
  5. }
  6. use strict;
  7. use warnings;
  8. use SDL;
  9. use SDL::Config;
  10. use Test::More;
  11. my $videodriver = $ENV{SDL_VIDEODRIVER};
  12. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  13. if ( SDL::Config->has('smpeg') ) {
  14. if( $ENV{SDL_RELEASE_TESTING} )
  15. {
  16. plan( tests => 17 );
  17. }
  18. else
  19. {
  20. plan( skip_all => "Skiping test for now. EXPERIMENTAL" );
  21. }
  22. } else {
  23. plan( skip_all => ( SDL::Config->has('smpeg') ? '' : ' smpeg support not compiled' ) );
  24. }
  25. use_ok('SDL::SMPEG');
  26. use SDL::Video;
  27. can_ok(
  28. 'SDL::SMPEG', qw/
  29. new
  30. error
  31. audio
  32. video
  33. volume
  34. display
  35. scale
  36. play
  37. pause
  38. stop
  39. rewind
  40. seek
  41. skip
  42. loop
  43. region
  44. frame
  45. info
  46. status
  47. /
  48. );
  49. # Create a video as it is done in the SYNOPSIS for SDL::SMPEG
  50. SCOPE: {
  51. my $smpeg = SDL::SMPEG->new(
  52. -name => 'test/data/test-mpeg.mpg',
  53. );
  54. isa_ok( $smpeg, 'SDL::SMPEG' );
  55. }
  56. # Get some information about a video
  57. SCOPE: {
  58. # TODO: On the following line we don't use the same code as
  59. # above, intentionally so we can evade the failing test and
  60. # continue testing. Once the above test case passes, merge
  61. # this with the test case above.
  62. my ($smpeg) = SDL::SMPEG->new(
  63. -name => 'test/data/test-mpeg.mpg',
  64. );
  65. isa_ok( $smpeg, 'SDL::SMPEG' );
  66. # Get the video metadata
  67. my $mpeg = $smpeg->info;
  68. isa_ok( $mpeg, 'SDL::SMPEG::Info' );
  69. # Check it matches what we expect
  70. is( $mpeg->has_audio, 1, '->has_audio ok' );
  71. is( $mpeg->has_video, 1, '->has_video ok' );
  72. is( $mpeg->width, 160, '->width ok' );
  73. is( $mpeg->height, 120, '->height ok' );
  74. is( $mpeg->size, 706564, '->size ok' );
  75. is( $mpeg->offset, 2717, '->offset ok' );
  76. is( $mpeg->frame, 0, '->frame ok' );
  77. is( $mpeg->time, 0, '->time ok' );
  78. like( $mpeg->length, qr/^21.3/, '->length ok' );
  79. # TODO: I'm not entirely sure this is meant to be zero
  80. is( $mpeg->fps, 0, '->fps ok' );
  81. # Create a display to attach the movie to
  82. my $surface = SDL::Video::set_video_mode(
  83. $mpeg->height,
  84. $mpeg->width,
  85. 32, # Colour bits
  86. SDL::Video::SDL_SWSURFACE, # flags
  87. );
  88. isa_ok( $surface, 'SDL::Surface' );
  89. # Attach the movie to a surface
  90. is( $smpeg->display($surface), undef, '->display(surface) ok' );
  91. # Now that we are bound we should be able to do things
  92. # to the movie and have them actually work.
  93. # Confirm we can change where we are in the video.
  94. # is( $smpeg->frame(5), undef, '->frame(5) ok' );
  95. $smpeg->play();
  96. # TODO: Figure out how this info object really works
  97. #is( $mpeg->current_frame, 5, '->frame updated in info object' );
  98. }
  99. if ($videodriver) {
  100. $ENV{SDL_VIDEODRIVER} = $videodriver;
  101. } else {
  102. delete $ENV{SDL_VIDEODRIVER};
  103. }