[ #214 ] Error location also for non-unique Bar.Bar::=...

The previous code would override the error location of the rule name Bar
with a no-position location of category Bar.

source/src/BNFC/CF.hs

@@ -306,7 +306,7 @@ data Position
     { posFile    :: FilePath  -- ^ Name of the grammar file.
     , posLine    :: Int       -- ^ Line in the grammar file.
     , posColumn  :: Int       -- ^ Column in the grammar file.
-    } deriving Show
+    } deriving (Show, Eq, Ord)
 
 prettyPosition :: Position -> String
 prettyPosition = \case
@@ -535,13 +535,16 @@ firstEntry cf =
 
 -- aggressively ban nonunique names (AR 31/5/2012)
 
--- | Categories and constructors.
+-- | Constructors and categories.
 allNames :: CF -> [RString]
-allNames cf = map (WithPosition NoPosition) (allCatsIdNorm cf) ++
+allNames cf =
   [ f | f <- map funRule $ cfgRules cf
       , not $ isNilCons f
       , not $ isCoercion f
-  ]
+  ] ++
+  allCatsIdNorm cf
+    -- Put the categories after the labels so that the error location
+    -- for a non-unique name is at the label rather than the category.
 
 -- | Get all elements with more than one occurrence.
 filterNonUnique :: (Ord a) => [a] -> [a]
@@ -598,8 +601,8 @@ allParserCats :: CFG f -> [Cat]
 allParserCats = allCats (== Parsable)
 
 -- | Gets all normalized identified Categories
-allCatsIdNorm :: CF -> [String]
-allCatsIdNorm = nub . map (identCat . normCat . valCat) . cfgRules
+allCatsIdNorm :: CF -> [RString]
+allCatsIdNorm = nub . map (fmap (identCat . normCat) . valRCat) . cfgRules
 
 -- | Get all normalized Cat
 allCatsNorm :: CF -> [Cat]

source/src/BNFC/GetCF.hs

@@ -112,13 +112,13 @@ parseCFP opts target content = do
     ns | target `elem` [ TargetCpp , TargetCppNoStl , TargetJava ]
        -> dieUnlessForce $ unlines $ concat
             [ [ "ERROR: names not unique:" ]
-            , map (("  " ++) . blendInPosition) ns
+            , printNames ns
             , [ "This is an error in the backend " ++ show target ++ "." ]
             ]
        | otherwise
        -> putStrLn $ unlines $ concat
             [ [ "Warning: names not unique:" ]
-            , map (("  " ++) . blendInPosition) ns
+            , printNames ns
             , [ "This can be an error in some backends." ]
             ]
 
@@ -127,14 +127,14 @@ parseCFP opts target content = do
     [] -> return ()
     ns | target `elem` [ TargetJava ]
        -> dieUnlessForce $ unlines $ concat
-            [ [ "ERROR: names not unique ignoring case: " ]
-            , map (("  " ++) . blendInPosition) ns
+            [ [ "ERROR: names not unique ignoring case:" ]
+            , printNames ns
             , [ "This is an error in the backend " ++ show target ++ "."]
             ]
        | otherwise
        -> putStr $ unlines $ concat
             [ [ "Warning: names not unique ignoring case:" ]
-            , map (("  " ++) . blendInPosition) ns
+            , printNames ns
             , [ "This can be an error in some backends." ]
             ]
 
@@ -158,7 +158,7 @@ parseCFP opts target content = do
             [ [ "Lower case rule labels need a definition."
               , "ERROR: undefined rule label(s):"
               ]
-            , map (("  " ++) . blendInPosition) xs
+            , printNames xs
             ]
 
   -- Print warnings if user defined nullable tokens.
@@ -185,6 +185,11 @@ parseCFP opts target content = do
         "Aborting.  (Use option --force to continue despite errors.)"
       exitFailure
 
+  printNames :: [RString] -> [String]
+  printNames = map (("  " ++) . blendInPosition) . List.sortOn lexicoGraphic
+    where
+    lexicoGraphic (WithPosition pos x) = (pos,x)
+
 die :: String -> IO a
 die msg = do
   hPutStrLn stderr msg

testing/succeed-lbnf/duplicate-label-same-cat.cf

@@ -1,2 +1,4 @@
 Foo.  Bar ::= "foo";
 Foo.  Bar ::= "foz";
+
+Baz.  Baz ::= "baz";

testing/succeed-lbnf/duplicate-label-same-cat.out

@@ -1,5 +1,6 @@
-Warning: names not unique: 
+Warning: names not unique:
   succeed-lbnf/duplicate-label-same-cat.cf:1:1: Foo
+  succeed-lbnf/duplicate-label-same-cat.cf:4:1: Baz
 This can be an error in some backends.
 
 2 rules accepted