File: Main.hs

package info (click to toggle)
haskell-ogma-cli 1.11.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 188 kB
  • sloc: haskell: 1,194; ansic: 16; makefile: 3
file content (183 lines) | stat: -rw-r--r-- 7,252 bytes parent folder | download | duplicates (2)
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
-- | Test Ogma
module Main where

import Data.List                      ( intercalate )
import Data.Monoid                    ( mempty )
import System.Exit                    ( ExitCode (ExitSuccess) )
import System.Process                 ( readProcessWithExitCode )
import Test.Framework                 ( Test, defaultMainWithOpts )
import Test.Framework.Providers.HUnit ( testCase )
import Test.HUnit                     ( assertBool )

-- | Run all unit tests on Ogma.
main :: IO ()
main =
  defaultMainWithOpts tests mempty

-- | All unit tests for Ogma
tests :: [Test.Framework.Test]
tests =
  [
    testCase "cli-main-ok" (runErrorCode ["--help" ] True)
    -- Should pass

  , testCase "cli-main-fail" (runErrorCode ["hfdsafdkajdfaskl"] False)
    -- Should fail due to arguments being incorrect

  , testCase "cli-cmd-structs" (runErrorCode ["structs", "--help" ] True)
    -- Should pass

  , testCase "cli-cmd-structs-fail" (runErrorCode ["structs", "--incorrect-argument"] False)
    -- Should fail due to arguments being incorrect

  , testCase "cli-cmd-handlers" (runErrorCode ["handlers", "--help" ] True)
    -- Should pass

  , testCase "cli-cmd-handlers-fail" (runErrorCode ["handlers", "--incorrect-argument"] False)
    -- Should fail due to arguments being incorrect

  , testCase "cli-cmd-cfs" (runErrorCode ["cfs", "--help" ] True)
    -- Should pass

  , testCase "cli-cmd-cfs-fail" (runErrorCode ["cfs", "--incorrect-argument"] False)
    -- Should fail due to arguments being incorrect

  , testCase "cli-cmd-standalone" (runErrorCode ["standalone", "--help" ] True)
    -- Should pass

  , testCase "cli-cmd-standalone-fail" (runErrorCode ["standalone", "--incorrect-argument"] False)
    -- Should fail due to arguments being incorrect

  , testCase "cli-cmd-standalone-fcs" (parseStandaloneFCS "tests/fcs-example1.json" True)
    -- Should pass

  , testCase "cli-cmd-standalone-file-not-found" (parseStandaloneFCS "tests/file-invalid.json" False)
    -- Should fail because the file does not exist

  , testCase "cli-cmd-standalone-parse-fail-1" (parseStandaloneFCS "tests/commands-fcs-error-parsing-failed-1.json" False)
    -- Should fail because the opening bracket is [ and not {

  , testCase "cli-cmd-standalone-parse-fail-2" (parseStandaloneFCS "tests/commands-fcs-error-parsing-failed-2.json" False)
    -- Should fail because a field is missing in an external variable

  , testCase "cli-cmd-standalone-parse-fail-3" (parseStandaloneFCS "tests/commands-fcs-error-parsing-failed-3.json" False)
    -- Should fail because a field is missing in an internal variable

  , testCase "cli-cmd-standalone-fdb" (parseStandaloneFDB "tests/fdb-example1.json")
    -- Should pass

  , testCase "structs-parse-ok" (testCStructs2Copilot "tests/reduced_geofence_msgs.h" True)
    -- Should pass

  , testCase "structs-parse-fail-1" (testCStructs2Copilot "tests/reduced_geofence_msgs_bad.h" False)
    -- Should fail because a keyword is incorrect
  ]

-- | Test C struct parser for a particular file.
--
-- This test uses the Copilot backend for C header files, so it generates
-- Copilot types and instances. It may be convenient to run this action in a
-- temporary directory.
--
-- This IO action fails if any of the following are true:
--   * Ogma cannot be found in the current PATH.
--   * Ogma cannot be executed.
--   * The given file is not found or accessible.
--   * The format in the given file is incorrect.
--   * Ogma fails due to an internal error or bug.
--   * The output file cannot be created due to lack of space or permissions.
--
testCStructs2Copilot :: FilePath  -- ^ Path to a C header file with structs
                     -> Bool
                     -> IO ()
testCStructs2Copilot file success = do
    (ec, _out, _err) <- readProcessWithExitCode "ogma" args ""

    -- True if success is expected and detected, or niether expected nor
    -- detected.
    let testPass = success == (ec == ExitSuccess)

    assertBool errorMsg testPass
  where
    args     = ["structs", "--header-file-name", file]
    errorMsg = "Result of processing file " ++ file ++ " failed"

-- | Test standalone backend for a FCS format and SVM.
--
-- This test uses the standalone backend, so it generates a Copilot file. It
-- may be convenient to run this action in a temporary directory.
--
-- This IO action fails if any of the following are true:
--   * Ogma cannot be found in the current PATH.
--   * Ogma cannot be executed.
--   * The given file is not found or accessible.
--   * The format in the given file is incorrect.
--   * Ogma fails due to an internal error or bug.
--   * The output file cannot be created due to lack of space or permissions.
--
parseStandaloneFCS :: FilePath  -- ^ Path to an input file
                   -> Bool
                   -> IO ()
parseStandaloneFCS file success = do
    (ec, _out, _err) <- readProcessWithExitCode "ogma" args ""

    -- True if success is expected and detected, or niether expected nor
    -- detected.
    let testPass = success == (ec == ExitSuccess)

    assertBool errorMsg testPass
  where
    args     = ["standalone", "--file-name", file]
    errorMsg = "Parsing file " ++ file ++ " result unexpected."

-- | Test standalone backend for FDB format and Lustre.
--
-- This test uses the standalone backend, so it generates a Copilot file. It
-- may be convenient to run this action in a temporary directory.
--
-- This IO action fails if any of the following are true:
--   * Ogma cannot be found in the current PATH.
--   * Ogma cannot be executed.
--   * The given file is not found or accessible.
--   * The format in the given file is incorrect.
--   * Ogma fails due to an internal error or bug.
--   * The output file cannot be created due to lack of space or permissions.
--
parseStandaloneFDB :: FilePath  -- ^ Path to an input file
                   -> IO ()
parseStandaloneFDB file = do
    (ec, _out, _err) <- readProcessWithExitCode "ogma" args ""
    assertBool errorMsg (ec == ExitSuccess)
  where
    args     = [ "standalone", "--file-name", file, "--input-format", "fdb"
               , "--prop-format", "lustre"]
    errorMsg = "Parsing file " ++ file ++ " failed"

-- | Test ogma by running it and checking the error code.
--
-- This tests just whether ogma finishes with an error code or not. If files
-- may be generated for the command being tested, it may be convenient to run
-- this action in a temporary directory.
--
-- This IO action fails if any of the following are true:
--   * Ogma cannot be found in the current PATH.
--   * Ogma cannot be executed.
--   * The given command is not valid.
--   * Ogma fails due to an internal error or bug.
--   * Output files cannot be created due to lack of space or permissions.
--
runErrorCode :: [String] -- ^ Arguments to pass to ogma
             -> Bool
             -> IO ()
runErrorCode args success = do
    (ec, _out, _err) <- readProcessWithExitCode "ogma" args ""

    -- True if success is expected and detected, or niether expected nor
    -- detected.
    let testPass = success == (ec == ExitSuccess)

    assertBool errorMsg testPass
  where
    errorMsg = "Testing ogma's CLI parser with arguments "
             ++ intercalate "," args
             ++ " failed"