# -*- tcl -*-
# jpeg.test:  Tests for the JPEG utilities.
#
# Copyright (c) 2008 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# JPEG: @(#) $Id: jpeg.test,v 1.1 2008/03/24 00:21:09 andreas_kupries 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}]]
	set s b
    } elseif {$lb < $la} {
	set a [string range $a 0 [expr {$lb - 1}]]
	set s a
    } else {
	set s -
    }
    set n -1
    foreach ca [split $a {}] cb [split $b {}] {
	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"}

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

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