Tcl Library Source Code

Check-in [d1adb3c859]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: Ticket [1d2b62d10d] followup. Extended testsuite with example image missing any embedded exif information (Not triggering the issue). Made testsuite 8.4+ and converted to tcltest 2 format.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d1adb3c8594f5057e1d09dcbca7b502d46b9caec
User & Date: andreask 2013-10-30 20:22:09
References
2013-10-30
20:24 Ticket [1d2b62d10d] jpeg::getExif crash status still Open with 3 other changes artifact: ee6212509a user: aku
Context
2013-11-03
11:19
Corrected calculation of corrector in heunStep check-in: 39bb693ab4 user: markus tags: trunk
2013-11-01
23:37
general cleanup. use expr operators like eq instead of string commands check-in: 913f7d92c5 user: pooryorick tags: pyk-mime-cleanup
2013-10-30
20:22
Ticket [1d2b62d10d] followup. Extended testsuite with example image missing any embedded exif information (Not triggering the issue). Made testsuite 8.4+ and converted to tcltest 2 format. check-in: d1adb3c859 user: andreask tags: trunk
2013-10-29
22:51
Merge sha* fixes. Audit of the other critcl parts was done, and no other misuse of cheaders was found. check-in: ad20454023 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/jpeg/ChangeLog.









1
2
3
4
5
6
7
8







2013-10-28  Andreas Kupries  <a[email protected]>

	* jpeg.tcl: Ticket [1d2b62d10d]: Fixed unwanted double-close of
	* jpeg.man: channel when accessing a non-existing thumbnail in a
	* pkgIndex.tcl: file. Introduced by the refactoring. Bumped
	  version to 0.5.

2013-02-01  Andreas Kupries  <[email protected]>
>
>
>
>
>
>
>
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
2013-10-30  Andreas Kupries <[email protected]>

	* testimage/IMG_7950_dt.JPG:  Ticket [1d2b62d10d] followup.
	* testimage/IMG_7950_dt.exif.txt: Extended testsuite with
	* testimage/IMG_7950_dt.thumbexif.txt: example image missing any
	  embedded exif information (Not triggering the issue). Made
	  testsuite 8.4+ and converted to tcltest 2 format.

2013-10-28  Andreas Kupries  <a[email protected]>

	* jpeg.tcl: Ticket [1d2b62d10d]: Fixed unwanted double-close of
	* jpeg.man: channel when accessing a non-existing thumbnail in a
	* pkgIndex.tcl: file. Introduced by the refactoring. Bumped
	  version to 0.5.

2013-02-01  Andreas Kupries  <[email protected]>

Changes to modules/jpeg/jpeg.tcl.

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
        } else {
            # number of entries in this exif block
            _scan $byteOrder [read $chan 2] s num
            # each entry is 12 bytes
            seek $chan [expr {$num * 12}] current
            # offset of next exif block (for thumbnail)
            _scan $byteOrder [read $chan 4] i next
            if {$next <= 0} { return }
            # but its relative to start
            seek $chan [expr {$start + $next}] start
            set data [_exif $chan $byteOrder $start]
        }
        lappend data ExifOffset $start ExifByteOrder $byteOrder
        return $data
    }






|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
        } else {
            # number of entries in this exif block
            _scan $byteOrder [read $chan 2] s num
            # each entry is 12 bytes
            seek $chan [expr {$num * 12}] current
            # offset of next exif block (for thumbnail)
            _scan $byteOrder [read $chan 4] i next
            if {$next <= 0} { close $chan ; return }
            # but its relative to start
            seek $chan [expr {$start + $next}] start
            set data [_exif $chan $byteOrder $start]
        }
        lappend data ExifOffset $start ExifByteOrder $byteOrder
        return $data
    }

Changes to modules/jpeg/jpeg.test.

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
...
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
303
304
305
306
307
308
309
310

311
312

313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351

352

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429




430





431





















432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470

471
472

473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
# -*- tcl -*-
# jpeg.test:  Tests for the JPEG utilities.
#
# Copyright (c) 2008 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# JPEG: @(#) $Id: jpeg.test,v 1.2 2011/05/06 13:39:27 patthoyts Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.2
testsNeedTcltest 1.0

support {
    use fileutil/fileutil.tcl fileutil
}
testing {
    useLocal jpeg.tcl jpeg
}

# -------------------------------------------------------------------------

test jpeg-1.0 {isJPEG error, wrong#args, not enough} {
    catch {::jpeg::isJPEG} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::isJPEG} {file} 0]

test jpeg-1.1 {isJPEG error, wrong#args, too many} {
    catch {::jpeg::isJPEG foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::isJPEG} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-2.$n "isJPEG, ok, [file tail $f]" {
	::jpeg::isJPEG $f
    } 1
    incr n
}

test jpeg-2.$n "isJPEG, fail, [file tail [info script]]" {
    ::jpeg::isJPEG [info script]
} 0

# -------------------------------------------------------------------------

test jpeg-2.0 {imageInfo error, wrong#args, not enough} {
    catch {::jpeg::imageInfo} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::imageInfo} {file} 0]

test jpeg-2.1 {imageInfo error, wrong#args, too many} {
    catch {::jpeg::imageInfo foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::imageInfo} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-3.$n "imageInfo regular, [file tail $f]" {
	::jpeg::imageInfo $f
    } {version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-4.$n "imageInfo thumbnails, [file tail $f]" {
	::jpeg::imageInfo $f
    } {}
    incr n
}

test jpeg-5.0 "imageInfo, fail, [file tail [info script]]" {
    list [catch {::jpeg::imageInfo [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-6.0 {dimensions error, wrong#args, not enough} {
    catch {::jpeg::dimensions} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::dimensions} {file} 0]

test jpeg-6.1 {dimensions error, wrong#args, too many} {
    catch {::jpeg::dimensions foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::dimensions} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-7.$n "dimensions regular, [file tail $f]" {
	::jpeg::dimensions $f
    } {320 240}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-8.$n "dimensions thumbnails, [file tail $f]" {
	::jpeg::dimensions $f
    } {160 120}
    incr n
}

test jpeg-9.0 "dimensions, fail, [file tail [info script]]" {
    list [catch {::jpeg::dimensions [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-10.0 {getThumbnail error, wrong#args, not enough} {
    catch {::jpeg::getThumbnail} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::getThumbnail} {file} 0]

test jpeg-10.1 {getThumbnail error, wrong#args, too many} {
    catch {::jpeg::getThumbnail foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::getThumbnail} {file}]

# -------------------------------------------------------------------------

proc strdiff {a b} {
    set la [string length $a]
    set lb [string length $b]
    if {$la < $lb} {
	set b [string range $b 0 [expr {$la - 1}]]
................................................................................
	incr n
	if {[string equal $ca $cb]} continue
	lappend s $n $ca $cb
    }
    return $s
}


























set n 0
























foreach f [TestFilesGlob testimages/*.JPG] {





































































    test jpeg-11.$n "getThumbnail regular, [file tail $f]" {
	#fileutil::writeFile -translation binary ${f}.x.jpg [::jpeg::getThumbnail $f]
	# Note: The .thumb files were created from the .JPG files
	# using 'jhead -st', version 2.6.
	set expected [fileutil::cat -translation binary ${f}.thumb]
	set have     [::jpeg::getThumbnail $f]
	list [string equal $expected $have] [strdiff $expected $have]
    } {1 -}


    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-12.$n "getThumbnail thumbnails, [file tail $f]" {
	::jpeg::getThumbnail $f
    } {}

    incr n
}

test jpeg-13.0 "getThumbnail, fail, [file tail [info script]]" {
    list [catch {::jpeg::getThumbnail [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-14.0 {exifKeys error, wrong#args, too many} {
    catch {::jpeg::exifKeys bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::exifKeys} {}]

# -------------------------------------------------------------------------

test jpeg-15.0 {exifKeys} {
    ::jpeg::exifKeys
} {SubjectDistanceRange InterColorProfile InteroperabilityIndex InteroperabilityVersion Copyright ShutterSpeedValue ApertureValue BrightnessValue ImageDescription ExposureBiasValue Make MaxApertureValue SubjectDistance FlashpixVersion MeteringMode ColorSpace LightSource XResolution ExifImageWidth Flash YResolution ExifImageHeight ImageNumber PlanarConfiguration RelatedSoundFile SecurityClassification CustomRendered ImageHistory ExposureMode WhiteBalance SubjectArea ExposureIndex DigitalZoomRatio ImageWidth UserComment TIFF/EPStandardID FocalLengthIn35mmFilm ImageLength TimeZoneOffset SceneCaptureType BitsPerSample SelfTimerMode GainControl Compression SubsecTime Contrast SubsecTimeOriginal Saturation SubsecTimeDigitized PhotometricInterpretation TransferFunction RelatedImageFileFormat RelatedImageWidth Model NewSubfileType RelatedImageLength StripOffsets SubfileType Orientation FlashEnergy SpatialFrequencyResponse Artist ImageUniqueID SamplesPerPixel Predictor FocalPlaneXResolution RowsPerStrip FocalPlaneYResolution StripByteCounts WhitePoint ExifVersion PrimaryChromaticities JPEGInterchangeFormat JPEGInterchangeFormatLength DateTimeOriginal ExposureProgram DateTimeDigitized CFARepeatPatternDim SubIFDs SpectralSensitivity GPSInfo CFAPattern BatteryLevel ISOSpeedRatings OECF Interlace ResolutionUnit YCbCrCoefficients ExposureTime YCbCrSubSampling Software YCbCrPositioning DateTime IPTC/NAA ReferenceBlackWhite FNumber JPEGTables ComponentsConfiguration FocalPlaneResolutionUnit FocalLength CompressedBitsPerPixel MakerNote SpatialFrequencyResponse Noise TileWidth TileLength SubjectLocation TileOffsets ExposureIndex TileByteCounts SensingMethod FileSource SceneType Sharpness CFAPattern DeviceSettingDescription}

# -------------------------------------------------------------------------

test jpeg-16.0 {getComments error, wrong#args, not enough} {
    catch {::jpeg::getComments} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::getComments} {file} 0]

test jpeg-16.1 {getComments error, wrong#args, too many} {
    catch {::jpeg::getComments foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::getComments} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-17.$n "getComments regular, [file tail $f]" {
	::jpeg::getComments $f
    } {}

    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-18.$n "getComments thumbnails, [file tail $f]" {
	::jpeg::getComments $f
    } {}

    incr n
}

test jpeg-19.0 "getComments, fail, [file tail [info script]]" {
    list [catch {::jpeg::getComments [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-20.0 {addComment error, wrong#args, not enough} {
    catch {::jpeg::addComment} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 0]

test jpeg-20.1 {addComment error, wrong#args, not enough} {
    catch {::jpeg::addComment foo} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 1]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-21.$n "addComment regular, [file tail $f]" {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}

	set res [::jpeg::getComments $fx]

	removeFile jtmp
	set res
    } {{a b} {c d}}
    incr n
}

test jpeg-22.0 "addComment, fail, [file tail [info script]]" {
    list [catch {::jpeg::addComment [info script] foo} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-23.0 {removeComments error, wrong#args, not enough} {
    catch {::jpeg::removeComments} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::removeComments} {file} 0]

test jpeg-23.1 {removeComments error, wrong#args, too many} {
    catch {::jpeg::removeComments foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::removeComments} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-24.$n "removeComments regular, [file tail $f]" {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment     $fx {a b} {c d}

	::jpeg::removeComments $fx
	set res [::jpeg::getComments $fx]

	removeFile jtmp
	set res
    } {}

    incr n
}

test jpeg-25.0 "removeComments, fail, [file tail [info script]]" {
    list [catch {::jpeg::removeComments [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-26.0 {replaceComment error, wrong#args, not enough} {
    catch {::jpeg::replaceComment} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0]

test jpeg-26.1 {replaceComment error, wrong#args, not enough} {
    catch {::jpeg::replaceComment foo} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0]

test jpeg-26.2 {replaceComment error, wrong#args, too many} {
    catch {::jpeg::replaceComment foo bar barf} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::replaceComment} {file comment}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-27.$n "replaceComment regular, [file tail $f]" {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment      $fx {a b} {c d}

	::jpeg::replaceComment $fx new
	set res [::jpeg::getComments $fx]

	removeFile jtmp
	set res
    } {new {c d}}
    incr n
}

test jpeg-28.0 "replaceComment, fail, [file tail [info script]]" {
    list [catch {::jpeg::replaceComment [info script] foo} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-29.0 {getExif error, wrong#args, not enough} {
    catch {::jpeg::getExif} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::getExif} {file ?type?} 0]

test jpeg-29.1 {getExif error, wrong#args, too many} {
    catch {::jpeg::getExif foo bar barf} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::getExif} {file ?type?}]

test jpeg-29.2 {getExif error, bad section type} {
    catch {::jpeg::getExif [localPath testimages/IMG_7950.JPG] fufara} msg
    set msg
} {Bad type "fufara", expected one of "main", or "thumbnail"}

test jpeg-29.3 {getExifFromChannel error, wrong#args, not enough} {
    catch {::jpeg::getExifFromChannel} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::getExifFromChannel} {chan ?type?} 0]

test jpeg-29.4 {getExifFromChannel error, wrong#args, too many} {
    catch {::jpeg::getExifFromChannel foo bar barf} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::getExifFromChannel} {chan ?type?}]

test jpeg-29.5 {getExifFromChannel error, bad section type} {
    set fd [::jpeg::openJFIF [localPath testimages/IMG_7950.JPG] r]

    catch {::jpeg::getExifFromChannel $fd fufara} msg

    close $fd
    set msg
} {Bad type "fufara", expected one of "main", or "thumbnail"}

# -------------------------------------------------------------------------

proc fixupdata {dict} {
    array set tmp $dict
    catch {unset tmp(MakerNote)}
    foreach k {
	FocalPlaneXResolution
	FocalPlaneYResolution
    } {
	if {![info exists tmp($k)]} continue
	set tmp($k) [format %8.2f $tmp($k)]
    }
    return [array get tmp]
}

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-30.$n "getExif, main section, $f" {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]]
    } [string trimright [fileutil::cat [file rootname $f].exif.txt]]
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-31.$n "getExif, main section, $f" {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]]
    } {}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-32.$n "getExif, thumbnail section, $f" {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]]
    } [string trimright [fileutil::cat [file rootname $f].thumbexif.txt]]
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-33.$n "getExif, thumbnail section, $f" {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]]
    } {}
    incr n
}

test jpeg-34.0 "getExif, fail, [file tail [info script]]" {
    list [catch {::jpeg::getExif [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------
# formatExif is implicitly tested in the previous tests (30-33), with getExif.

test jpeg-33.0 {formatExif error, wrong#args, not enough} {
    catch {::jpeg::formatExif} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::formatExif} {exif} 0]

test jpeg-33.1 {formatExif error, wrong#args, too many} {
    catch {::jpeg::formatExif foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::formatExif} {exif}]

# -------------------------------------------------------------------------

test jpeg-34.0 {removeExif error, wrong#args, not enough} {
    catch {::jpeg::removeExif} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::removeExif} {file} 0]

test jpeg-34.1 {removeExif error, wrong#args, too many} {
    catch {::jpeg::removeExif foo bar} msg




    set msg





} [tcltest::tooManyArgs {::jpeg::removeExif} {file}]






















# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-35.$n "removeExif ok, [file tail $f]" {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}
	::jpeg::removeExif $fx
	set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]]
	removeFile jtmp
	set res
    } {{{a b} {c d}} {} {}}
    incr n
}

test jpeg-36.0 "removeExif, fail, [file tail [info script]]" {
    list [catch {::jpeg::removeExif [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-37.0 {stripJPEG error, wrong#args, not enough} {
    catch {::jpeg::stripJPEG} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::stripJPEG} {file} 0]

test jpeg-37.1 {stripJPEG error, wrong#args, too many} {
    catch {::jpeg::stripJPEG foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::stripJPEG} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-38.$n "stripJPEG ok, [file tail $f]" {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}

	::jpeg::stripJPEG $fx
	set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]]

	removeFile jtmp
	set res
    } {{} {} {}}
    incr n
}

test jpeg-39.0 "stripJPEG, fail, [file tail [info script]]" {
    list [catch {::jpeg::stripJPEG [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------

test jpeg-40.0 {debug error, wrong#args, not enough} {
    catch {::jpeg::debug} msg
    set msg
} [tcltest::wrongNumArgs {::jpeg::debug} {file} 0]

test jpeg-40.1 {debug error, wrong#args, too many} {
    catch {::jpeg::debug foo bar} msg
    set msg
} [tcltest::tooManyArgs {::jpeg::debug} {file}]

# -------------------------------------------------------------------------
# We do not try to actually run 'debug', because it prints its results
# to stdout. This may change when we can capture stdout as test result

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-41.$n "debug ok, [file tail $f]" donotrun {
	::jpeg::debug $f
    } {}
    incr n
}

test jpeg-42.0 "debug, fail, [file tail [info script]]" {
    list [catch {::jpeg::debug [info script]} msg] $msg
} {1 {not a jpg file}}

# -------------------------------------------------------------------------
rename strdiff {}
testsuiteCleanup


|










|
|








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
>
>





|

<
>



|
|
|



|
|
<
|



|

|



|
|
<
|

|
|
<
|





|

<
>





|

<
>



|
|
|



|
|
<
|

|
|
<
|





|


>
|
>
|
|
|



|
|
|



|
|
<
|

|
|
<
|





|


>

|
>
|
|
<
>



|
|
|



|
|
<
|

|
|
<
|

|
|
<
|





|


>

|
>
|
|
|



|
|
|



|
|
<
|

|
|
<
|

|
|
<
|

|
|
<
|

|
|
<
|

|

>
|
>

|
|



<
<
<
<
<
<
<
<
<
<
<
<
<


|

|





|

|





|

|





|

|



|
|
|




|
|
<
|

|
|
<
|



|
|
<
|

|
|
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|


>


>
|
|
|



|
|
|



|
|
<
|

|
|
<
|







|

|



|
|
|




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
..
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
303
304
305

306
307
308
309

310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336

337
338
339
340

341
342
343
344

345
346
347
348

349
350
351
352

353
354
355
356
357
358
359
360
361
362
363
364
365













366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406

407
408
409
410

411
412
413
414
415
416

417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457































458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478

479
480
481
482

483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
# -*- tcl -*-
# jpeg.test:  Tests for the JPEG utilities.
#
# Copyright (c) 2008-2013 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# JPEG: @(#) $Id: jpeg.test,v 1.2 2011/05/06 13:39:27 patthoyts Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.4
testsNeedTcltest 2

support {
    use fileutil/fileutil.tcl fileutil
}
testing {
    useLocal jpeg.tcl jpeg
}











































































































# -------------------------------------------------------------------------

proc strdiff {a b} {
    set la [string length $a]
    set lb [string length $b]
    if {$la < $lb} {
	set b [string range $b 0 [expr {$la - 1}]]
................................................................................
	incr n
	if {[string equal $ca $cb]} continue
	lappend s $n $ca $cb
    }
    return $s
}

proc fixupdata {dict} {
    array set tmp $dict
    catch {unset tmp(MakerNote)}
    foreach k {
	FocalPlaneXResolution
	FocalPlaneYResolution
    } {
	if {![info exists tmp($k)]} continue
	set tmp($k) [format %8.2f $tmp($k)]
    }
    return [array get tmp]
}

# -------------------------------------------------------------------------

test jpeg-1.0 {isJPEG error, wrong#args, not enough} -body {
    ::jpeg::isJPEG
} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::isJPEG} {file} 0]

test jpeg-1.1 {isJPEG error, wrong#args, too many} -body {
    ::jpeg::isJPEG foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::isJPEG} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-2.$n "isJPEG, ok, [file tail $f]" -body {
	::jpeg::isJPEG $f
    } -result 1
    incr n
}

test jpeg-2.$n "isJPEG, fail, [file tail [info script]]" -body {
    ::jpeg::isJPEG [info script]
} -result 0

# -------------------------------------------------------------------------

test jpeg-2.0 {imageInfo error, wrong#args, not enough} -body {
    ::jpeg::imageInfo
} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::imageInfo} {file} 0]

test jpeg-2.1 {imageInfo error, wrong#args, too many} -body {
    ::jpeg::imageInfo foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::imageInfo} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-3.$n "imageInfo regular, [file tail $f]" -body {
	::jpeg::imageInfo $f
    } -result [string trim [fileutil::cat [file rootname $f].info.txt]]
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-4.$n "imageInfo thumbnails, [file tail $f]" -body {
	::jpeg::imageInfo $f
    } -result {}
    incr n
}

test jpeg-5.0 "imageInfo, fail, [file tail [info script]]" -body {
    ::jpeg::imageInfo [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-6.0 {dimensions error, wrong#args, not enough} -body {
    ::jpeg::dimensions
} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::dimensions} {file} 0]

test jpeg-6.1 {dimensions error, wrong#args, too many} -body {
    ::jpeg::dimensions foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::dimensions} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-7.$n "dimensions regular, [file tail $f]" -body {
	::jpeg::dimensions $f
    } -result {320 240}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-8.$n "dimensions thumbnails, [file tail $f]" -body {
	::jpeg::dimensions $f
    } -result {160 120}
    incr n
}

test jpeg-9.0 "dimensions, fail, [file tail [info script]]" -body {
::jpeg::dimensions [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-10.0 {getThumbnail error, wrong#args, not enough} -body {
    ::jpeg::getThumbnail
} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getThumbnail} {file} 0]

test jpeg-10.1 {getThumbnail error, wrong#args, too many} -body {
    ::jpeg::getThumbnail foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getThumbnail} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    if {![file exists $f.thumb]} {
	test jpeg-11.$n "getThumbnail - no thumbnail, [file tail $f]" -body {
	    ::jpeg::getThumbnail $f
	} -result {}
    } else {
	test jpeg-11.$n "getThumbnail regular, [file tail $f]" -body {
	    #fileutil::writeFile -translation binary ${f}.x.jpg [::jpeg::getThumbnail $f]
	    # Note: The .thumb files were created from the .JPG files
	    # using 'jhead -st', version 2.6.
	    set expected [fileutil::cat -translation binary ${f}.thumb]
	    set have     [::jpeg::getThumbnail $f]
	    list [string equal $expected $have] [strdiff $expected $have]
	} -result {1 -}
    }

    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-12.$n "getThumbnail thumbnails, [file tail $f]" -body {
	::jpeg::getThumbnail $f

    } -result {}
    incr n
}

test jpeg-13.0 "getThumbnail, fail, [file tail [info script]]" -body {
    ::jpeg::getThumbnail [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-14.0 {exifKeys error, wrong#args, too many} -body {
    ::jpeg::exifKeys bar

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::exifKeys} {}]

# -------------------------------------------------------------------------

test jpeg-15.0 {exifKeys} -body {
    ::jpeg::exifKeys
} -result {SubjectDistanceRange InterColorProfile InteroperabilityIndex InteroperabilityVersion Copyright ShutterSpeedValue ApertureValue BrightnessValue ImageDescription ExposureBiasValue Make MaxApertureValue SubjectDistance FlashpixVersion MeteringMode ColorSpace LightSource XResolution ExifImageWidth Flash YResolution ExifImageHeight ImageNumber PlanarConfiguration RelatedSoundFile SecurityClassification CustomRendered ImageHistory ExposureMode WhiteBalance SubjectArea ExposureIndex DigitalZoomRatio ImageWidth UserComment TIFF/EPStandardID FocalLengthIn35mmFilm ImageLength TimeZoneOffset SceneCaptureType BitsPerSample SelfTimerMode GainControl Compression SubsecTime Contrast SubsecTimeOriginal Saturation SubsecTimeDigitized PhotometricInterpretation TransferFunction RelatedImageFileFormat RelatedImageWidth Model NewSubfileType RelatedImageLength StripOffsets SubfileType Orientation FlashEnergy SpatialFrequencyResponse Artist ImageUniqueID SamplesPerPixel Predictor FocalPlaneXResolution RowsPerStrip FocalPlaneYResolution StripByteCounts WhitePoint ExifVersion PrimaryChromaticities JPEGInterchangeFormat JPEGInterchangeFormatLength DateTimeOriginal ExposureProgram DateTimeDigitized CFARepeatPatternDim SubIFDs SpectralSensitivity GPSInfo CFAPattern BatteryLevel ISOSpeedRatings OECF Interlace ResolutionUnit YCbCrCoefficients ExposureTime YCbCrSubSampling Software YCbCrPositioning DateTime IPTC/NAA ReferenceBlackWhite FNumber JPEGTables ComponentsConfiguration FocalPlaneResolutionUnit FocalLength CompressedBitsPerPixel MakerNote SpatialFrequencyResponse Noise TileWidth TileLength SubjectLocation TileOffsets ExposureIndex TileByteCounts SensingMethod FileSource SceneType Sharpness CFAPattern DeviceSettingDescription}

# -------------------------------------------------------------------------

test jpeg-16.0 {getComments error, wrong#args, not enough} -body {
    ::jpeg::getComments

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getComments} {file} 0]

test jpeg-16.1 {getComments error, wrong#args, too many} -body {
    ::jpeg::getComments foo bar

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getComments} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-17.$n "getComments regular, [file tail $f]" -body {
	::jpeg::getComments $f

    } -result {}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-18.$n "getComments thumbnails, [file tail $f]" -body {
	::jpeg::getComments $f

    } -result {}
    incr n
}

test jpeg-19.0 "getComments, fail, [file tail [info script]]" -body {
    ::jpeg::getComments [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-20.0 {addComment error, wrong#args, not enough} -body {
    ::jpeg::addComment

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 0]

test jpeg-20.1 {addComment error, wrong#args, not enough} -body {
    ::jpeg::addComment foo

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::addComment} {file comment args} 1]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-21.$n "addComment regular, [file tail $f]" -setup {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}
    } -body {
	::jpeg::getComments $fx
    } -cleanup {
	removeFile $fx
	unset fx
    } -result {{a b} {c d}}
    incr n
}

test jpeg-22.0 "addComment, fail, [file tail [info script]]" -body {
    ::jpeg::addComment [info script] foo
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-23.0 {removeComments error, wrong#args, not enough} -body {
    ::jpeg::removeComments

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::removeComments} {file} 0]

test jpeg-23.1 {removeComments error, wrong#args, too many} -body {
    ::jpeg::removeComments foo bar

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::removeComments} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-24.$n "removeComments regular, [file tail $f]" -setup {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment     $fx {a b} {c d}
    } -body {
	::jpeg::removeComments $fx
	::jpeg::getComments $fx
    } -cleanup {
	removeFile $fx
	unset fx

    } -result {}
    incr n
}

test jpeg-25.0 "removeComments, fail, [file tail [info script]]" -body {
    ::jpeg::removeComments [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-26.0 {replaceComment error, wrong#args, not enough} -body {
    ::jpeg::replaceComment

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0]

test jpeg-26.1 {replaceComment error, wrong#args, not enough} -body {
    ::jpeg::replaceComment foo

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::replaceComment} {file comment} 0]

test jpeg-26.2 {replaceComment error, wrong#args, too many} -body {
    ::jpeg::replaceComment foo bar barf

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::replaceComment} {file comment}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-27.$n "replaceComment regular, [file tail $f]" -setup {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment      $fx {a b} {c d}
    } -body {
	::jpeg::replaceComment $fx new
	::jpeg::getComments $fx
    } -cleanup {
	removeFile $fx
	unset fx
    } -result {new {c d}}
    incr n
}

test jpeg-28.0 "replaceComment, fail, [file tail [info script]]" -body {
    ::jpeg::replaceComment [info script] foo
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-29.0 {getExif error, wrong#args, not enough} -body {
    ::jpeg::getExif

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getExif} {file ?type?} 0]

test jpeg-29.1 {getExif error, wrong#args, too many} -body {
    ::jpeg::getExif foo bar barf

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getExif} {file ?type?}]

test jpeg-29.2 {getExif error, bad section type} -body {
    ::jpeg::getExif [localPath testimages/IMG_7950.JPG] fufara

} -returnCodes error -result {Bad type "fufara", expected one of "main", or "thumbnail"}

test jpeg-29.3 {getExifFromChannel error, wrong#args, not enough} -body {
    ::jpeg::getExifFromChannel

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::getExifFromChannel} {chan ?type?} 0]

test jpeg-29.4 {getExifFromChannel error, wrong#args, too many} -body {
    ::jpeg::getExifFromChannel foo bar barf

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::getExifFromChannel} {chan ?type?}]

test jpeg-29.5 {getExifFromChannel error, bad section type} -setup {
    set fd [::jpeg::openJFIF [localPath testimages/IMG_7950.JPG] r]
} -body {
    ::jpeg::getExifFromChannel $fd fufara
} -cleanup {
    close $fd
    unset fd
} -returnCodes error -result {Bad type "fufara", expected one of "main", or "thumbnail"}

# -------------------------------------------------------------------------














set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-30.$n "getExif, main section, $f" -body {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]]
    } -result [string trimright [fileutil::cat [file rootname $f].exif.txt]]
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-31.$n "getExif, main section, $f" -body {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f]]]
    } -result {}
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.JPG] {
    test jpeg-32.$n "getExif, thumbnail section, $f" -body {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]]
    } -result [string trimright [fileutil::cat [file rootname $f].thumbexif.txt]]
    incr n
}

set n 0
foreach f [TestFilesGlob testimages/*.thumb] {
    test jpeg-33.$n "getExif, thumbnail section, $f" -body {
	dictsort [fixupdata [::jpeg::formatExif [::jpeg::getExif $f thumbnail]]]
    } -result {}
    incr n
}

test jpeg-34.0 "getExif, fail, [file tail [info script]]" -body {
    ::jpeg::getExif [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------
# formatExif is implicitly tested in the previous tests (30-33), with getExif.

test jpeg-33.0 {formatExif error, wrong#args, not enough} -body {
    ::jpeg::formatExif

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::formatExif} {exif} 0]

test jpeg-33.1 {formatExif error, wrong#args, too many} -body {
    ::jpeg::formatExif foo bar

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::formatExif} {exif}]

# -------------------------------------------------------------------------

test jpeg-34.0 {removeExif error, wrong#args, not enough} -body {
    ::jpeg::removeExif

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::removeExif} {file} 0]

test jpeg-34.1 {removeExif error, wrong#args, too many} -body {
    ::jpeg::removeExif foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::removeExif} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-35.$n "removeExif ok, [file tail $f]" -setup {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}
    } -body {
	::jpeg::removeExif $fx
	set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]]
    } -cleanup {
	removeFile $fx
	unset fx
    } -result {{{a b} {c d}} {} {}}
    incr n
}

test jpeg-36.0 "removeExif, fail, [file tail [info script]]" -body {
::jpeg::removeExif [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-37.0 {stripJPEG error, wrong#args, not enough} -body {
    ::jpeg::stripJPEG
} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::stripJPEG} {file} 0]

test jpeg-37.1 {stripJPEG error, wrong#args, too many} -body {
    ::jpeg::stripJPEG foo bar
} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::stripJPEG} {file}]

# -------------------------------------------------------------------------

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {































    test jpeg-38.$n "stripJPEG ok, [file tail $f]" -setup {
	file copy -force $f [set fx [makeFile {} jtmp]]
	::jpeg::addComment $fx {a b} {c d}
    } -body {
	::jpeg::stripJPEG $fx
	set res [list [::jpeg::getComments $fx] [::jpeg::getExif $fx] [::jpeg::getExif $fx thumbnail]]
    } -cleanup {
	removeFile $fx
	unset fx
    } -result {{} {} {}}
    incr n
}

test jpeg-39.0 "stripJPEG, fail, [file tail [info script]]" -body {
    ::jpeg::stripJPEG [info script]
}  -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------

test jpeg-40.0 {debug error, wrong#args, not enough} -body {
    ::jpeg::debug

} -returnCodes error -result [tcltest::wrongNumArgs {::jpeg::debug} {file} 0]

test jpeg-40.1 {debug error, wrong#args, too many} -body {
    ::jpeg::debug foo bar

} -returnCodes error -result [tcltest::tooManyArgs {::jpeg::debug} {file}]

# -------------------------------------------------------------------------
# We do not try to actually run 'debug', because it prints its results
# to stdout. This may change when we can capture stdout as test result

set n 0
foreach f [TestFilesGlob testimages/*JPG*] {
    test jpeg-41.$n "debug ok, [file tail $f]" -constraints donotrun -body {
	::jpeg::debug $f
    } -result {}
    incr n
}

test jpeg-42.0 "debug, fail, [file tail [info script]]" -body {
    ::jpeg::debug [info script]
} -returnCodes error -result {not a jpg file}

# -------------------------------------------------------------------------
rename strdiff {}
testsuiteCleanup

Added modules/jpeg/testimages/IMG_7898.info.txt.



>
1
version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0

Added modules/jpeg/testimages/IMG_7917.info.txt.



>
1
version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0

Added modules/jpeg/testimages/IMG_7950.info.txt.



>
1
version 1.1 units 1 xdensity 180 ydensity 180 xthumb 0 ythumb 0

Added modules/jpeg/testimages/IMG_7950_none.JPG.

cannot compute difference between binary files

Added modules/jpeg/testimages/IMG_7950_none.exif.txt.

Added modules/jpeg/testimages/IMG_7950_none.info.txt.



>
1
version 1.1 units 1 xdensity 300 ydensity 300 xthumb 0 ythumb 0

Added modules/jpeg/testimages/IMG_7950_none.thumbexif.txt.