From b18c060e5cb708901eb29f1f27b25c467875a143 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 28 Jun 2012 15:38:52 -0400 Subject: [PATCH] Add some tests for the article URL construction. --- makefile | 14 +++++++++++--- src/LWN/URI.hs | 13 +++++++++++++ src/Main.hs | 49 ++++++++++++++++++++++++++++++++++++++++++----- test/TestSuite.hs | 4 +++- 4 files changed, 71 insertions(+), 9 deletions(-) diff --git a/makefile b/makefile index 15a2187..ec658b0 100644 --- a/makefile +++ b/makefile @@ -1,6 +1,11 @@ .PHONY : test publish_doc doc src_html hlint -lwn-epub: src/*.hs +# There's onlt one '$' in the awk script, but we have to double-money +# it for make. +PN := $(shell grep 'name:' *.cabal | awk '{ print $$2 }') +BIN := dist/build/$(PN)/$(PN) + +$(BIN): src/*.hs runghc Setup.hs clean runghc Setup.hs configure --user --flags=${FLAGS} runghc Setup.hs build @@ -19,5 +24,8 @@ doc: src_html --executables \ --hyperlink-source -test: - runghc -i"src" test/TestSuite.hs +dist/build/autogen: $(BIN) + + +test: dist/build/autogen + runghc -i"src" -i"dist/build/autogen" test/TestSuite.hs diff --git a/src/LWN/URI.hs b/src/LWN/URI.hs index 1cf8826..7aa4240 100644 --- a/src/LWN/URI.hs +++ b/src/LWN/URI.hs @@ -40,6 +40,19 @@ http_port uri = parse_result = uriAuthority uri +make_https :: URL -> URL +make_https url = + case parse_result of + Nothing -> url -- Shrug? + Just uri -> + if http uri then + show $ uri { uriScheme = "https:" } + else + url -- Leave non-http URLs alone. + where + parse_result = parseURIReference url + + -- | Does this URI use an HTTPS-compatible port? https_port :: URI -> Bool https_port uri = diff --git a/src/Main.hs b/src/Main.hs index 47c69fa..924b9a5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,13 +11,16 @@ import System.IO ( stdout ) import System.IO.UTF8 (readFile) +import Test.HUnit (Assertion, assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) import Text.Regex.Posix ((=~)) import Text.XML.HXT.Core import CommandLine (show_help) import Configuration (Cfg(..), get_cfg) import LWN.Page -import LWN.URI (is_lwn_url, make_absolute_url) +import LWN.URI (is_lwn_url, make_absolute_url, make_https) import Misc (contains) @@ -70,16 +73,16 @@ real_article_path s = do case make_absolute_url "current" of Nothing -> s Just ac -> ac - abs_s = - case make_absolute_url s of + abs_article = + case make_absolute_url ("Articles/" ++ s) of Nothing -> s Just as -> as check_cases :: String check_cases - | is_lwn_url s = s + | is_lwn_url s = make_https s | s `contains` "current" = abs_current - | s =~ "^[0-9]+$" = abs_s + | s =~ "^[0-9]+$" = abs_article | otherwise = s -- Give up main :: IO () @@ -101,3 +104,39 @@ main = do Nothing -> do _ <- show_help return () + + + +test_current_article_path :: Assertion +test_current_article_path = do + let expected = "https://lwn.net/current" + actual <- real_article_path "current" + assertEqual "Current article path constructed" expected actual + +test_numbered_article_path :: Assertion +test_numbered_article_path = do + let expected = "https://lwn.net/Articles/69" + actual <- real_article_path "69" -- I'm twelve + assertEqual "Numbered article path constructed" expected actual + + +test_full_article_path :: Assertion +test_full_article_path = do + let expected = "https://lwn.net/Articles/502979/" + actual <- real_article_path "https://lwn.net/Articles/502979/" + assertEqual "Full article path left alone" expected actual + +test_non_https_article_path :: Assertion +test_non_https_article_path = do + let expected = "https://lwn.net/Articles/502979/" + actual <- real_article_path "http://lwn.net/Articles/502979/" + assertEqual "Non-https URL made https" expected actual + +main_tests :: Test +main_tests = + testGroup "Main Tests" [ + testCase "Current article path constructed" test_current_article_path, + testCase "Numbered article path constructed" test_numbered_article_path, + testCase "Full article path left alone" test_full_article_path, + testCase "Non-https URL made https" test_non_https_article_path ] + \ No newline at end of file diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 791408e..ce648dc 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -15,6 +15,7 @@ import Test.Framework.Runners.Options import Test.Framework.Providers.API (TestName) import Test.HUnit +import Main (main_tests) import LWN.Page (page_tests) import LWN.URI (uri_tests) @@ -22,5 +23,6 @@ main :: IO () main = defaultMain tests tests :: [Test.Framework.Test] -tests = [ page_tests, +tests = [ main_tests, + page_tests, uri_tests ] -- 2.44.2