File: test_ffmpeg_in.scm

package info (click to toggle)
aiscm 0.20.1-1
  • links: PTS
  • area: main
  • in suites: bullseye, sid
  • size: 7,084 kB
  • sloc: lisp: 7,406; sh: 4,184; ansic: 3,613; makefile: 266
file content (302 lines) | stat: -rw-r--r-- 11,887 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
;; AIscm - Guile extension for numerical arrays and tensors.
;; Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018, 2019 Jan Wedekind <jan@wedesoft.de>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
(use-modules (srfi srfi-1)
             (srfi srfi-64)
             (oop goops)
             (aiscm ffmpeg)
             (aiscm samples)
             (aiscm image)
             (aiscm core))


(test-begin "aiscm ffmpeg")

(load-extension "libguile-aiscm-tests" "init_tests")

(test-begin "helper methods")
  (test-assert "Convert array with one integer to 64 bit"
    (int-array-to-long-one-element))
  (test-assert "Convert array with two integers to 64 bit"
    (int-array-to-long-second-element))
  (test-assert "Convert empty integer array to Scheme array"
    (null? (from-array-empty)))
  (test-equal "Convert integer array with three elements to Scheme array"
    '(2 3 5) (from-array-three-elements))
  (test-equal "Convert integer array to Scheme array stopping at first zero element"
    '(2 3 5) (from-array-stop-at-zero))
  (test-equal "Convert zero array with minimum number of elements"
    '(0) (from-array-at-least-one))
  (test-equal "Convert long integer array element to Scheme"
    (list (ash 42 32)) (from-array-long-integers))

  (test-begin "convert pointers to offsets")
    (test-assert "First value of offset-array is zero"
      (first-offset-is-zero))
    (test-assert "Second value of offset-array correct"
      (second-offset-correct))
    (test-assert "Set offset values for null pointers to zero"
      (zero-offset-for-null-pointer))
    (test-assert "Offsets have 64 bit"
      (offsets-have-64-bit (ash 1 62)))
  (test-end "convert pointers to offsets")

  (test-assert "Pack byte audio sample"
    (pack-byte-audio-sample))
  (test-assert "Pack byte audio samples"
    (pack-byte-audio-samples))
  (test-assert "Pack short integer audio samples"
    (pack-short-int-audio-samples))

  (define-class <dummy> ()
    (video-buffer #:init-value '())
    (video-pts  #:init-value 0))
  (let [(dummy (make <dummy>))]
    (test-assert "Popping buffer should return #f when empty"
      (not (video-buffer-pop dummy))))
  (let [(dummy (make <dummy>))]
    (video-buffer-push dummy (cons 123 'dummy-frame))
    (video-buffer-push dummy (cons 456 'other-frame))
    (test-eq "Popping buffer should return first frame"
      'dummy-frame (video-buffer-pop dummy))
    (test-eq "Popping buffer should set the time stamp"
      123 (slot-ref dummy 'video-pts))
    (test-eq "Popping buffer again should return the second frame"
      'other-frame (video-buffer-pop dummy))
    (test-eq "Popping buffer again should set the time stamp"
      456 (slot-ref dummy 'video-pts)))
(test-end "helper methods")

(test-begin "video input")
  (define input-video (open-ffmpeg-input "fixtures/av-sync.mp4"))

  (test-assert "Video input is an input object"
    (is-input? input-video))
  (test-assert "Video has video stream"
    (have-video? input-video))
  (test-assert "'open-ffmpeg-input' creates an FFmpeg object"
    (is-a? input-video <ffmpeg>))
  (test-equal "Check frame size of input video"
    '(360 640) (shape input-video))
  (test-eqv "Get frame rate of input video"
    25 (frame-rate input-video))
  (test-equal "Get aspect ratio of input video"
    1 (aspect-ratio input-video))
  (test-eqv "Detect stereo audio stream"
    2 (channels input-video))

  (define video-pts0 (video-pts input-video))
  (define video-frame (read-image input-video))

  (test-assert "Check that video frame is an image object"
    (is-a? video-frame <image>))
  (test-equal "Check shape of video frame"
    '(360 640) (shape video-frame))
  (test-equal "Check a pixel in the first video frame of the video"
    (rgb 154 154 154) (get (from-image video-frame) 10 270))

  (define video-pts1 (video-pts input-video))
  (read-image input-video)
  (define video-pts2 (video-pts input-video))

  (test-equal "Check first three video frame time stamps"
    (list 0 0 (/ 1 25)) (list video-pts0 video-pts1 video-pts2))

  (pts= input-video 15)
  (read-image input-video)

  (test-assert "Seeking audio/video should update the video position"
    (<= 15 (video-pts input-video)))

  (buffer-timestamped-video 15 input-video)
  (pts= input-video 15)
  (test-assert "Flush video buffer when seeking in input video"
    (zero? (video-buffer-fill input-video)))

  (destroy input-video)

  (define full-video (open-ffmpeg-input "fixtures/av-sync.mp4"))
  (define images (map (lambda _ (read-image full-video)) (iota 2253)))
  (test-assert "Check last image of video was read"
    (last images))
  (test-assert "Check 'read-image' returns false after last frame"
    (not (read-image full-video)))
  (destroy full-video)

  (test-error "Throw exception when trying to write to input video"
    'misc-error (write-image colour-image (open-ffmpeg-input "fixtures/av-sync.mp4")))
  (test-error "Throw error if file does not exist"
    'misc-error (open-ffmpeg-input "fixtures/no-such-file.avi"))
(test-end "video input")

(test-begin "image input")
  (define decoded (decode-audio/video (open-ffmpeg-input "fixtures/fubk.png")))

  (test-eq "Decoding image data results in a video frame"
    'video (car decoded))
  (test-eqv "Decoding image data results a trivial time stamp"
    0 (cadr decoded))

  (define image (open-ffmpeg-input "fixtures/fubk.png"))
  (decode-audio/video image)
  (test-assert "Return false after decoding last frame"
    (not (decode-audio/video image)))

  (define image (open-ffmpeg-input "fixtures/fubk.png"))
  (test-eqv "Video buffer is empty initially"
    0 (video-buffer-fill image))
  (decode-audio/video image)
  (test-assert "Buffering video should return true"
    (buffer-timestamped-video 123 image))
  (test-eqv "Video buffer contains one frame after buffering a frame"
    1 (video-buffer-fill image))
  (test-equal "Timestamp is stored in buffer"
    123 (caar (slot-ref image 'video-buffer)))
  (test-equal "Shape of buffered video frame is the same"
    '(288 384) (shape (cdar (slot-ref image 'video-buffer))))
  (test-assert "Stored frame is a duplicate (i.e. not the same)"
    (not (eq? video-frame (cdar (slot-ref image 'video-buffer)))))

  (define image (open-ffmpeg-input "fixtures/fubk.png"))
  (test-assert "Image has only one video frame"
    (not (cadr (list (read-image image) (read-image image)))))
  (test-assert "Image does not have audio data"
    (not (have-audio? image)))
  (test-assert "Do not hang when reading audio from image"
    (not (read-audio image 4410))); test should not hang

  (test-error "Image does not have audio channels"
    'misc-error (channels image))
  (test-error "Image does not have an audio sampling rate"
    'misc-error (rate image))
  (test-error "Image does not have an audio sample type"
    'misc-error (typecode image))
  (destroy image)

  (define image (open-ffmpeg-input "fixtures/fubk.png"))
  (read-audio image 4410)
  (test-assert "Cache video data when reading audio"
    (read-image image))
  (destroy image)
(test-end "image input")

(test-begin "audio input")
  (define decoded (decode-audio/video (open-ffmpeg-input "fixtures/mono.mp3")))
  (test-eq "Decoding audio data results in an audio frame"
    'audio (car decoded))
  (test-eqv "Decoding audio data results a trivial time stamp"
    0 (cadr decoded))

  (define audio-mono (open-ffmpeg-input "fixtures/mono.mp3"))
  (test-assert "Audio file does not have a video stream"
    (not (have-video? audio-mono)))
  (test-assert "Do not hang when attempting to read an image from an audio file"
    (not (read-image audio-mono)))
  (test-assert "Audio input has audio stream"
    (have-audio? audio-mono))
  (test-eqv "Audio buffer fill is zero initially"
    0 (audio-buffer-fill audio-mono))
  (define audio-samples (read-audio audio-mono 4410))
  (test-equal "Retrieve specified number of audio samples"
    '(4410 1) (shape audio-samples))
  (test-eq "Typecode of samples is typecode of input"
    (typecode audio-mono) (typecode audio-samples))
  (test-eq "Rate of samples is rate of input"
    (rate audio-mono) (rate audio-samples))
  (test-assert "Samples are packed"
    (not (planar? audio-samples)))
(test-end "audio input")

(test-begin "audio input")
  (define audio-mono (open-ffmpeg-input "fixtures/mono.mp3"))
  (test-error "Audio file does not have width and height"
    'misc-error (shape audio-mono))
  (test-error "Audio file does not have a frame rate"
    'misc-error (frame-rate audio-mono))
  (test-eqv "Detect mono audio stream"
    1 (channels audio-mono))
  (test-eqv "Get sampling rate of audio stream"
    8000 (rate audio-mono))
  (test-skip 1)
  (test-eq "Get type of audio samples"
    <sint> (typecode audio-mono))

  (define audio-mono (open-ffmpeg-input "fixtures/mono.mp3"))
  (decode-audio/video audio-mono)
  (test-assert "Buffering audio should return true"
    (buffer-timestamped-audio 123 audio-mono))
  (test-assert "Buffering input audio should increase the buffer size"
    (not (zero? (audio-buffer-fill audio-mono))))

  (define wav (open-ffmpeg-input "fixtures/cat.wav"))
  (test-assert "Query typecode of WAV file"
    (typecode wav))
  (test-assert "Read from WAV file"
    (read-audio wav 4410))

  (define samples (to-samples (to-array <sint> '((2) (3) (5) (7) (3) (4) (6) (8))) 8000))
  (fetch-audio audio-mono samples)
  (test-skip 1)
  (test-equal "Fetching back buffered audio should maintain the values"
    '((0) (0) (0) (0) (0) (0) (0) (0)) (to-list (to-array samples)))

  (define audio-mono (open-ffmpeg-input "fixtures/mono.mp3"))
  (define audio-pts0 (audio-pts audio-mono))
  (define audio-mono-frame (read-audio audio-mono 4410))

  (test-assert "Check that audio frame is a set of samples"
    (is-a? audio-mono-frame <samples>))
  (test-skip 1)
  (test-eqv "Get a value from a mono audio frame"
    40 (get (to-array audio-mono-frame) 0 300))
  (test-eqv "Mono audio frame should have 1 channel"
    1 (channels audio-mono-frame))
  (test-equal "Mono audio frame should have the desired shape"
    '(4410 1) (shape audio-mono-frame))
  (test-skip 1)
  (test-eq "Audio frame should have samples of correct type"
    <sint> (typecode audio-mono-frame))

  (define audio-mono (open-ffmpeg-input "fixtures/mono.mp3"))
  (define audio-pts0 (audio-pts audio-mono))
  (read-audio audio-mono 800)
  (define audio-pts1 (audio-pts audio-mono))
  (read-audio audio-mono 800)
  (define audio-pts2 (audio-pts audio-mono))
  (test-equal "Check first three audio frame time stamps"
    (list 0 (/ 1 10) (/ 2 10)) (list audio-pts0 audio-pts1 audio-pts2))

  (pts= audio-mono 1)
  (test-eqv "Seeking in the audio stream should flush the audio buffer"
    0 (audio-buffer-fill audio-mono))

  (pts= audio-mono 35)
  (test-assert "Return a smaller frame when attempting to read beyond the end of the audio stream"
    (< (cadr (shape (read-audio audio-mono 441000))) 441000)); test should not hang
  (test-assert "Check 'read-audio' returns false after last audio sample"
    (not (read-audio audio-mono 4410)))

  (destroy audio-mono)

  (define audio-stereo (open-ffmpeg-input "fixtures/test.mp3"))

  (test-eqv "Stereo audio frame should have 2 channels"
    2 (channels (read-audio audio-stereo 4410)))

  (destroy audio-stereo)
(test-end "audio input")

(test-end "aiscm ffmpeg")