From cf88742981c11bbe2c38a219f86726628a40ee62 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 12:58:15 +0100 Subject: [PATCH 1/7] Add opus_compare to repo, call it from Haskel during tests The goal is to have opus_compare in source code format (for minimal footprint), and ideally in unaltered form from the Xiph repo for easy updates/reproducibility. We (ab)use the fact that Cabal can compile normal C code. Specifically, we build opus_compare.c and link to it from Haskell and call into its main function using an FFI wrapper (OpusCompare.hs). To avoid having multiple definitions of main(), we use the cc-options field in the cabal file to rename the main function in opus_compare.c to opus_compare_main. This is a bit of a hack, but it works and is simple. No more need to run gcc separately and have a separate executable, or to need to install opus-tools locally! --- .gitignore | 1 - README.md | 1 + opus.cabal | 7 +- test/OpusCompare.hs | 46 ++++++ test/Spec.hs | 50 ++---- test/opus_compare.c | 382 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 444 insertions(+), 43 deletions(-) create mode 100644 test/OpusCompare.hs create mode 100644 test/opus_compare.c diff --git a/.gitignore b/.gitignore index 26a47e2..da8653a 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,3 @@ TAGS dist-newstyle/ opus_newvectors/ tmp.out -opus_compare* diff --git a/README.md b/README.md index b33e13c..ffb04ec 100644 --- a/README.md +++ b/README.md @@ -8,3 +8,4 @@ $ curl -OL https://opus-codec.org/docs/opus_testvectors-rfc8251.tar.gz ``` +test/opus_compare.c is taken as-is from Xiph.Org Foundation under the BSD-3 license. diff --git a/opus.cabal b/opus.cabal index 74aee23..f9a7fb4 100644 --- a/opus.cabal +++ b/opus.cabal @@ -71,10 +71,13 @@ test-suite opus-test default-language: Haskell2010 hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: OpusCompare + c-sources: test/opus_compare.c + cc-options: -Dmain=opus_compare_main + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base, opus, bytestring, hspec, microlens, - process + directory diff --git a/test/OpusCompare.hs b/test/OpusCompare.hs new file mode 100644 index 0000000..2db6db9 --- /dev/null +++ b/test/OpusCompare.hs @@ -0,0 +1,46 @@ +-- | This module is a wrapper around opus_compare.c. +-- Calling 'compareFiles' is equivalent to running the opus_compare executable. +-- Due to conflicting definitions of "main" (one in opus_compare and one in our +-- Haskell program), we assume that opus_compare has been compiled with a define +-- that renames its main function to "opus_compare_main". +module OpusCompare where + +import Codec.Audio.Opus.Internal.Opus +import Foreign +import Foreign.C.Types +import Foreign.C.String + +-- | Channel type +data Channel = Mono | Stereo + deriving (Eq, Show) + +-- | Compares two Opus files using the opus_compare executable code. The result +-- is True if the files are quality-wise identical (which doesn't necessarily +-- mean that they are byte-wise identical due to entropy in the Opus encoding). +-- The result is False if the files are measurably different. +compareFiles :: Channel -> SamplingRate -> FilePath -> FilePath -> IO Bool +compareFiles channel samplingRate filePath1 filePath2 = + withCString "opus_compare" $ \cProgramName -> + withCString "-r" $ \cSROpt -> -- sampling rate option + withCString (show $ unSamplingRate samplingRate) $ \cSRVal -> -- sampling rate value + withCString filePath1 $ \cFile1 -> -- first file + withCString filePath2 $ \cFile2 -> -- second file + if channel == Mono + then allocaArray 5 $ \p -> do + pokeArray p [cProgramName, cSROpt, cSRVal, cFile1, cFile2] + c_opus_compare_main 5 p >>= \r -> return (r == 0) + else withCString "-s" $ \cSOpt -> -- stereo option + allocaArray 6 $ \p -> do + pokeArray p [cProgramName, cSOpt, cSROpt, cSRVal, cFile1, cFile2] + c_opus_compare_main 6 p >>= \r -> return (r == 0) + +-- | Call the opus_compare_main function, which should be the main function +-- within opus_compare.c. We assume that when compiling opus_compare.c, a +-- define was used to rename the main function to "opus_compare_main". +foreign import ccall unsafe "opus_compare.c opus_compare_main" + c_opus_compare_main + :: Int + -- ^ number of arguments + -> Ptr (Ptr CChar) + -- ^ arguments + -> IO Int diff --git a/test/Spec.hs b/test/Spec.hs index a5151a7..478b764 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,10 +9,9 @@ import qualified Data.ByteString as B import Data.Bits import Data.List import Data.Word (Word8) -import System.Exit -import System.Process +import System.Directory (doesDirectoryExist) import Test.Hspec - +import qualified OpusCompare as Opus cfgs :: [EncoderConfig] cfgs = [mkEncoderConfig sr s c | sr <- srs, s <- ss, c <- cs] @@ -31,12 +30,10 @@ testEncoderCreate cfg = opusEncoderCreate cfg >>= (`shouldSatisfy` const True) -onlyIfOpusCompareExists :: IO () -> IO () -onlyIfOpusCompareExists action = do - result <- try $ readProcessWithExitCode "./opus_compare" [] "" - case (result :: Either IOException (ExitCode, String, String)) of - Right (ExitFailure 1, _, _) -> action - _ -> fail "opus_compare executable not found" +onlyIfTestVectorsExist :: IO () -> IO () +onlyIfTestVectorsExist action = do + exists <- doesDirectoryExist "opus_newvectors" + if exists then action else fail "opus_newvectors directory not found" decodeFile :: DecoderConfig -> B.ByteString -> IO B.ByteString decodeFile decoderCfg bytes = do @@ -78,49 +75,22 @@ main :: IO () main = hspec $ do describe "opusEncoderCreate" $ seqWithCfgs testEncoderCreate - around_ onlyIfOpusCompareExists $ do - -- These tests require the opus_compare executable to be present in the - -- project root, and the opus test vectors, downloaded from the official + around_ onlyIfTestVectorsExist $ do + -- These tests require the opus test vectors, downloaded from the official -- opus website. describe "opus mono test vectors" $ forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do it ("mono testvector " <> file) $ do let decoderCfg = mkDecoderConfig opusSR48k False B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" - -- Use readProcessWithExitCode to account for the fact that opus_compare - -- returns a non-zero exit code if the comparing fails. - (exitcode1, stdout1, error1) <- readProcessWithExitCode "./opus_compare" - ["-r", "48000" - , "opus_newvectors/testvector" <> file <> ".dec" - , "tmp.out" - ] "" - (exitcode2, stdout2, error2) <- readProcessWithExitCode "./opus_compare" - ["-r", "48000" - , "opus_newvectors/testvector" <> file <> "m.dec" - , "tmp.out" - ] "" - shouldSatisfy (error1, error2) $ \(a, b) -> "PASSES" `isInfixOf` a || "PASSES" `isInfixOf` b + Opus.compareFiles Opus.Mono opusSR48k ("opus_newvectors/testvector" <> file <> "m.dec") "tmp.out" >>= shouldBe True describe "opus stereo test vectors" $ forM_ ["01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"] $ \file -> do it ("stereo testvector " <> file) $ do let decoderCfg = mkDecoderConfig opusSR48k True B.readFile ("opus_newvectors/testvector" <> file <> ".bit") >>= decodeFile decoderCfg >>= B.writeFile "tmp.out" - -- Use readProcessWithExitCode to account for the fact that opus_compare - -- returns a non-zero exit code if the comparing fails. - (exitcode1, stdout1, error1) <- readProcessWithExitCode "./opus_compare" - [ "-s" - , "-r", "48000" - , "opus_newvectors/testvector" <> file <> ".dec" - , "tmp.out" - ] "" - (exitcode2, stdout2, error2) <- readProcessWithExitCode "./opus_compare" - [ "-s" - , "-r", "48000" - , "opus_newvectors/testvector" <> file <> "m.dec" - , "tmp.out" - ] "" - shouldSatisfy (error1, error2) $ \(a, b) -> "PASSES" `isInfixOf` a || "PASSES" `isInfixOf` b + Opus.compareFiles Opus.Stereo opusSR48k ("opus_newvectors/testvector" <> file <> ".dec") "tmp.out" >>= shouldBe True {- diff --git a/test/opus_compare.c b/test/opus_compare.c new file mode 100644 index 0000000..1956e08 --- /dev/null +++ b/test/opus_compare.c @@ -0,0 +1,382 @@ +/* Copyright (c) 2011-2012 Xiph.Org Foundation, Mozilla Corporation + Written by Jean-Marc Valin and Timothy B. Terriberry */ +/* + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + - Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + - Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER + OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, + EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR + PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*/ + +#include +#include +#include +#include + +#define OPUS_PI (3.14159265F) + +#define OPUS_COSF(_x) ((float)cos(_x)) +#define OPUS_SINF(_x) ((float)sin(_x)) + +static void *check_alloc(void *_ptr){ + if(_ptr==NULL){ + fprintf(stderr,"Out of memory.\n"); + exit(EXIT_FAILURE); + } + return _ptr; +} + +static void *opus_malloc(size_t _size){ + return check_alloc(malloc(_size)); +} + +static void *opus_realloc(void *_ptr,size_t _size){ + return check_alloc(realloc(_ptr,_size)); +} + +static size_t read_pcm16(float **_samples,FILE *_fin,int _nchannels){ + unsigned char buf[1024]; + float *samples; + size_t nsamples; + size_t csamples; + size_t xi; + size_t nread; + samples=NULL; + nsamples=csamples=0; + for(;;){ + nread=fread(buf,2*_nchannels,1024/(2*_nchannels),_fin); + if(nread<=0)break; + if(nsamples+nread>csamples){ + do csamples=csamples<<1|1; + while(nsamples+nread>csamples); + samples=(float *)opus_realloc(samples, + _nchannels*csamples*sizeof(*samples)); + } + for(xi=0;xi=_window_sz)ti-=_window_sz; + } + re*=_downsample; + im*=_downsample; + _ps[(xi*ps_sz+xj)*_nchannels+ci]=re*re+im*im+100000; + p[ci]+=_ps[(xi*ps_sz+xj)*_nchannels+ci]; + } + } + if(_out){ + _out[(xi*_nbands+bi)*_nchannels]=p[0]/(_bands[bi+1]-_bands[bi]); + if(_nchannels==2){ + _out[(xi*_nbands+bi)*_nchannels+1]=p[1]/(_bands[bi+1]-_bands[bi]); + } + } + } + } + free(window); +} + +#define NBANDS (21) +#define NFREQS (240) + +/*Bands on which we compute the pseudo-NMR (Bark-derived + CELT bands).*/ +static const int BANDS[NBANDS+1]={ + 0,2,4,6,8,10,12,14,16,20,24,28,32,40,48,56,68,80,96,120,156,200 +}; + +#define TEST_WIN_SIZE (480) +#define TEST_WIN_STEP (120) + +int main(int _argc,const char **_argv){ + FILE *fin1; + FILE *fin2; + float *x; + float *y; + float *xb; + float *X; + float *Y; + double err; + float Q; + size_t xlength; + size_t ylength; + size_t nframes; + size_t xi; + int ci; + int xj; + int bi; + int nchannels; + unsigned rate; + int downsample; + int ybands; + int yfreqs; + int max_compare; + if(_argc<3||_argc>6){ + fprintf(stderr,"Usage: %s [-s] [-r rate2] \n", + _argv[0]); + return EXIT_FAILURE; + } + nchannels=1; + if(strcmp(_argv[1],"-s")==0){ + nchannels=2; + _argv++; + } + rate=48000; + ybands=NBANDS; + yfreqs=NFREQS; + downsample=1; + if(strcmp(_argv[1],"-r")==0){ + rate=atoi(_argv[2]); + if(rate!=8000&&rate!=12000&&rate!=16000&&rate!=24000&&rate!=48000){ + fprintf(stderr, + "Sampling rate must be 8000, 12000, 16000, 24000, or 48000\n"); + return EXIT_FAILURE; + } + downsample=48000/rate; + switch(rate){ + case 8000:ybands=13;break; + case 12000:ybands=15;break; + case 16000:ybands=17;break; + case 24000:ybands=19;break; + } + yfreqs=NFREQS/downsample; + _argv+=2; + } + fin1=fopen(_argv[1],"rb"); + if(fin1==NULL){ + fprintf(stderr,"Error opening '%s'.\n",_argv[1]); + return EXIT_FAILURE; + } + fin2=fopen(_argv[2],"rb"); + if(fin2==NULL){ + fprintf(stderr,"Error opening '%s'.\n",_argv[2]); + fclose(fin1); + return EXIT_FAILURE; + } + /*Read in the data and allocate scratch space.*/ + xlength=read_pcm16(&x,fin1,2); + if(nchannels==1){ + for(xi=0;xi0;){ + for(ci=0;ci0){ + /*Temporal masking: -3 dB/2.5ms slope.*/ + for(bi=0;bi=79&&xj<=81)im*=0.1F; + if(xj==80)im*=0.1F; + Eb+=im; + } + } + Eb /= (BANDS[bi+1]-BANDS[bi])*nchannels; + Ef += Eb*Eb; + } + /*Using a fixed normalization value means we're willing to accept slightly + lower quality for lower sampling rates.*/ + Ef/=NBANDS; + Ef*=Ef; + err+=Ef*Ef; + } + free(xb); + free(X); + free(Y); + err=pow(err/nframes,1.0/16); + Q=100*(1-0.5*log(1+err)/log(1.13)); + if(Q<0){ + fprintf(stderr,"Test vector FAILS\n"); + fprintf(stderr,"Internal weighted error is %f\n",err); + return EXIT_FAILURE; + } + else{ + fprintf(stderr,"Test vector PASSES\n"); + fprintf(stderr, + "Opus quality metric: %.1f %% (internal weighted error is %f)\n",Q,err); + return EXIT_SUCCESS; + } +} From b2a03eee4716736075a70178d3efbdb14e76ff01 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 17:06:58 +0100 Subject: [PATCH 2/7] Disable fprintf from opus_compare during tests using a wrapper file --- opus.cabal | 6 ++++-- test/OpusCompare.hs | 2 +- test/opus_compare_wrapper.c | 7 +++++++ 3 files changed, 12 insertions(+), 3 deletions(-) create mode 100644 test/opus_compare_wrapper.c diff --git a/opus.cabal b/opus.cabal index f9a7fb4..988f6af 100644 --- a/opus.cabal +++ b/opus.cabal @@ -40,6 +40,8 @@ tested-with: GHC ==9.4.8 extra-source-files: README.md ChangeLog.md + test/opus_compare_wrapper.c + test/opus_compare.c source-repository head type: git @@ -72,8 +74,8 @@ test-suite opus-test hs-source-dirs: test other-modules: OpusCompare - c-sources: test/opus_compare.c - cc-options: -Dmain=opus_compare_main + c-sources: test/opus_compare_wrapper.c + include-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base, opus, diff --git a/test/OpusCompare.hs b/test/OpusCompare.hs index 2db6db9..a7d3246 100644 --- a/test/OpusCompare.hs +++ b/test/OpusCompare.hs @@ -37,7 +37,7 @@ compareFiles channel samplingRate filePath1 filePath2 = -- | Call the opus_compare_main function, which should be the main function -- within opus_compare.c. We assume that when compiling opus_compare.c, a -- define was used to rename the main function to "opus_compare_main". -foreign import ccall unsafe "opus_compare.c opus_compare_main" +foreign import ccall unsafe "opus_compare_wrapper.c opus_compare_main" c_opus_compare_main :: Int -- ^ number of arguments diff --git a/test/opus_compare_wrapper.c b/test/opus_compare_wrapper.c new file mode 100644 index 0000000..af9001e --- /dev/null +++ b/test/opus_compare_wrapper.c @@ -0,0 +1,7 @@ +// A wrapper for opus_compare.c which renames the main symbol to avoid conflits +// with Haskell, and which disables the use of fprintf. +#define main opus_compare_main +#define fprintf(out,fmt,...) +#include "opus_compare.c" +#undef main +#undef fprintf From a0311a4e90b2aaf2215ee0be6b330fab412c6828 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 17:10:54 +0100 Subject: [PATCH 3/7] Set up Opus test vectors within CI --- .github/workflows/test.yaml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index 5221da0..60cbb90 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -73,6 +73,10 @@ jobs: restore-keys: | ${{ runner.os }}-${{ matrix.ghc }}- + - name: Download Opus test vectors + # This creates a folder called opus_newvectors with the test vectors + run: curl -L https://opus-codec.org/static/testvectors/opus_testvectors-rfc8251.tar.gz | tar -xz + - name: Run the tests # Use --enable-tests until https://github.com/haskell/cabal/issues/7883 # is fixed, as otherwise cabal test can sometimes reach a local maxima From 83c3d7ed0faa00be4cf28a161577a74bb004b07c Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 17:29:39 +0100 Subject: [PATCH 4/7] Fix Windows CI erroring on Opus vector download due to weird curl/tar --- .github/workflows/test.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index 60cbb90..9336c27 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -75,6 +75,7 @@ jobs: - name: Download Opus test vectors # This creates a folder called opus_newvectors with the test vectors + shell: bash run: curl -L https://opus-codec.org/static/testvectors/opus_testvectors-rfc8251.tar.gz | tar -xz - name: Run the tests From f21ed191f44c5e10e0954915334dd89794ab349e Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 17:54:21 +0100 Subject: [PATCH 5/7] Fix fprintf compilation error by including stdio in opus_compare wrapper --- test/opus_compare_wrapper.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test/opus_compare_wrapper.c b/test/opus_compare_wrapper.c index af9001e..4210561 100644 --- a/test/opus_compare_wrapper.c +++ b/test/opus_compare_wrapper.c @@ -1,7 +1,17 @@ // A wrapper for opus_compare.c which renames the main symbol to avoid conflits // with Haskell, and which disables the use of fprintf. + +// First, include stdio to prevent the fprintf definition later from breaking +// the definition of fprintf +#include + +// Rewrite main to opus_compare_main to prevent conflits when FFI-ed #define main opus_compare_main + +// Rewrite all fprintf to a no-op #define fprintf(out,fmt,...) #include "opus_compare.c" + +// Undefine main and fprintf for safety #undef main #undef fprintf From dfa934cb652a4711afbffa3ce64b47cec5eef7af Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 18:11:51 +0100 Subject: [PATCH 6/7] Set fail-fast to false on CI to test all platforms even if one fails --- .github/workflows/test.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index 9336c27..874ec91 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -29,6 +29,7 @@ jobs: runs-on: ${{ matrix.os }} strategy: matrix: ${{ fromJSON(needs.generate-matrix.outputs.matrix) }} + fail-fast: false steps: - name: Checkout the repository uses: actions/checkout@v4 From e52938f3e6a3e2e7d787867af388b541fcf72100 Mon Sep 17 00:00:00 2001 From: Yuto Takano Date: Fri, 14 Feb 2025 18:12:32 +0100 Subject: [PATCH 7/7] Rename CI workflow file from test.yaml to run_tests.yaml for clarity --- .github/workflows/{test.yaml => run_tests.yaml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename .github/workflows/{test.yaml => run_tests.yaml} (100%) diff --git a/.github/workflows/test.yaml b/.github/workflows/run_tests.yaml similarity index 100% rename from .github/workflows/test.yaml rename to .github/workflows/run_tests.yaml