[fix #151] Don't print defined categores on missing production

BNFC · Jul 20, 2015 · 71fab43 · 71fab43
1 parent de5c91e
commit 71fab43
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 5 deletions.
diff --git a/source/src/BNFC/GetCF.hs b/source/src/BNFC/GetCF.hs
@@ -18,7 +18,7 @@
 -}
 
 
-module BNFC.GetCF(parseCF, parseCFP, transItem) where
+module BNFC.GetCF where
 
 import qualified AbsBNF as Abs
 import ParBNF
@@ -34,6 +34,8 @@ import Data.Either (partitionEithers)
 import Data.List(nub,partition)
 import Data.Maybe (mapMaybe)
 import ErrM
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
 
 -- $setup
 -- >>> import PrintBNF
@@ -77,7 +79,7 @@ parseCFP opts target content = do
 
   where
     runErr (Ok a) = return a
-    runErr (Bad msg) = error msg
+    runErr (Bad msg) = hPutStrLn stderr msg >> exitFailure
 
 {-
     case filter (not . isDefinedRule) $ notUniqueFuns cf of
@@ -388,8 +390,8 @@ checkRule cf (Rule (f,_) cat rhs)
   | badSpecial     = Just $ "Bad special category rule" +++ s
   | badTypeName    = Just $ "Bad type name" +++ unwords (map show badtypes) +++ "in" +++ s
   | badFunName     = Just $ "Bad constructor name" +++ f +++ "in" +++ s
-  | badMissing     = Just $ "No production for" +++ unwords missing ++
-                             ", appearing in rule" +++ s +++ ". Defined categories:" +++ unwords defineds
+  | badMissing     = Just $ "no production for" +++ unwords missing ++
+                             ", appearing in rule\n    " ++ s
   | otherwise      = Nothing
  where
    s  = f ++ "." +++ show cat +++ "::=" +++ unwords (map (either show show) rhs) -- Todo: consider using the show instance of Rule

diff --git a/source/test/BNFC/GetCFSpec.hs b/source/test/BNFC/GetCFSpec.hs
@@ -24,3 +24,13 @@ spec = do
 
     it "splits multiwords terminals" $
         transItem (Abs.Terminal "foo bar") `shouldBe` [Right "foo", Right "bar"]
+
+  describe "checkRule" $ do
+
+    it "returns an error if the rule uses an unknown category" $ do
+        let rulep = Rule ("Foo", ("Foo", [])) (Cat "Bar") [Left (Cat "Baz")]
+            rule = Rule "Foo" (Cat "Bar") [Left (Cat "Baz")]
+            cf = CFG (([],([],[],[],[])),[rule])
+            expected =
+                "no production for Baz, appearing in rule\n    Foo. Bar ::= Baz"
+        checkRule cf rulep `shouldBe` Just expected
diff --git a/testing/src/RegressionTests.hs b/testing/src/RegressionTests.hs
@@ -16,7 +16,8 @@ all = makeTestSuite "Regression tests"
     [ issue30, issue31
     , issue60
     , issue108, issue110, issue111, issue114, issue113
-    , issue127, issue128 ]
+    , issue127, issue128
+    , issue151 ]
 
 issue30 :: Test
 issue30 = makeShellyTest "#30 With -d option XML module is not generated inside the directorty" $
@@ -128,3 +129,19 @@ issue128 = makeShellyTest "#128 Cannot use B as a constructor in haskell" $
         cd tmp
         cmd "bnfc" "--haskell" "-m" "grammar.cf"
         cmd "make"
+
+-- | Issue # 151
+issue151 :: Test
+issue151 = makeShellyTest "#151 Shouldn't print all categories in error message" $
+    withTmpDir $ \tmp -> do
+        cd tmp
+        writefile "test.cf" "Foo. Bar ::= Baz"
+        errExit False $ do
+          cmd "bnfc" "test.cf"
+          code <- lastExitCode
+          err <- lastStderr
+          assertEqual code 1
+          let expectedErr = T.unlines
+                  [ "no production for Baz, appearing in rule"
+                  , "    Foo. Bar ::= Baz", "" ]
+          assertEqual expectedErr err