Fix #479: C: case-sensitive labels: preserve case in union member names

Java does not suffer case-sensitive labels as each label becomes a class in its own file.
Thus, we check this and throw an error.
Consequently, test 479_LabelsCaseSensitive is broken for the java backends.

source/CHANGELOG.md

@@ -1,5 +1,7 @@
 # Unreleased
 
+* C: preserve case in constructors (union): e.g. label `EInt` now is union member `eInt_` rather than `eint_`
+  [[#479](https://github.com/BNFC/bnfc/issues/479)]
 
 # 2.9.5
 

source/src/BNFC/Backend/C/CFtoCAbs.hs

@@ -35,7 +35,7 @@ import BNFC.PrettyPrint
 import BNFC.Options  ( RecordPositions(..) )
 import BNFC.Utils    ( (+++), unless )
 import BNFC.Backend.Common.NamedVariables
-import BNFC.Backend.C.Common ( posixC )
+import BNFC.Backend.C.Common ( posixC, memName )
 
 
 -- | The result is two files (.H file, .C file)
@@ -304,12 +304,12 @@ mkCFile datas _cf = concat
 --   switch(p->kind)
 --   {
 --   case is_EInt:
---     return make_EInt (p->u.eint_.integer_);
+--     return make_EInt (p->u.eInt_.integer_);
 -- <BLANKLINE>
 --   case is_EAdd:
 --     return make_EAdd
---       ( clone_Exp(p->u.eadd_.exp_1)
---       , clone_Exp(p->u.eadd_.exp_2)
+--       ( clone_Exp(p->u.eAdd_.exp_1)
+--       , clone_Exp(p->u.eAdd_.exp_2)
 --       );
 -- <BLANKLINE>
 --   default:
@@ -375,7 +375,7 @@ prCloneC (cat, rules)
   prCloneCat :: String -> (Cat, Doc) -> String
   prCloneCat fnm (cat, nt) = cloner cat member
     where
-    member = concat [ "p->u.", map toLower fnm, "_.", render nt ]
+    member = concat [ "p->u.", memName fnm, ".", render nt ]
 
 -- | Clone or not depending on the category.
 --   Only pointers need to be cloned.
@@ -401,8 +401,8 @@ cloner cat x =
 --     break;
 -- <BLANKLINE>
 --   case is_EAdd:
---     free_Exp(p->u.eadd_.exp_1);
---     free_Exp(p->u.eadd_.exp_2);
+--     free_Exp(p->u.eAdd_.exp_1);
+--     free_Exp(p->u.eAdd_.exp_2);
 --     break;
 -- <BLANKLINE>
 --   default:
@@ -482,8 +482,8 @@ prDestructorC (cat, rules)
   prFreeCat fnm (cat, nt) = Just $ concat
       [ maybe ("free_" ++ identCat (normCat cat)) (const "free") $ maybeTokenCat cat
       , "(p->u."
-      , map toLower fnm
-      , "_.", render nt, ");"
+      , memName fnm
+      , ".", render nt, ");"
       ]
 
 
@@ -614,21 +614,15 @@ prParams = zipWith prParam [1::Int ..]
     prParam n c = (text (identCat c), text ("p" ++ show n))
 
 -- | Prints the assignments of parameters to instance variables.
--- >>> prAssigns "A" [("A",1),("B",2)] [text "abc", text "def"]
+-- >>> prAssigns "A" [("A",1),("BA",2)] [text "abc", text "def"]
 -- tmp->u.a_.a_ = abc;
--- tmp->u.a_.b_2 = def;
+-- tmp->u.a_.ba_2 = def;
 prAssigns :: String -> [IVar] -> [Doc] -> Doc
 prAssigns c vars params = vcat $ zipWith prAssign vars params
   where
     prAssign (t,n) p =
-        text ("tmp->u." ++ c' ++ "_." ++ vname t n) <+> char '=' <+> p <> semi
+        text ("tmp->u." ++ memName c ++ "." ++ vname t n) <+> char '=' <+> p <> semi
     vname t n
       | n == 1, [_] <- filter ((t ==) . fst) vars
                   = varName t
       | otherwise = varName t ++ showNum n
-    c' = map toLower c
-
-{- **** Helper Functions **** -}
-
-memName :: String -> String
-memName s = map toLower s ++ "_"

source/src/BNFC/Backend/C/CFtoCPrinter.hs

@@ -33,7 +33,8 @@ import BNFC.Utils     ( (+++), uniqOn, unless, unlessNull )
 
 import BNFC.Backend.Common
 import BNFC.Backend.Common.NamedVariables
-import BNFC.Backend.Common.StrUtils (renderCharOrString)
+import BNFC.Backend.Common.StrUtils       ( renderCharOrString )
+import BNFC.Backend.C.Common              ( memName )
 
 -- | Produces (.h file, .c file).
 
@@ -446,7 +447,7 @@ prPrintRule r@(Rule fun _ _ _) = unless (isCoercion fun) $ concat
   where
     p   = precRule r
     fnm = funName fun
-    pre = concat [ "p->u.", map toLower fnm, "_." ]
+    pre = concat [ "p->u.", memName fnm, "." ]
 
 -- | Only render the rhs (items) of a rule.
 
@@ -567,8 +568,8 @@ prShowCat fnm (cat, nt) = concat
   [ "    sh"
   , maybe (identCat $ normCat cat) basicFunName $ maybeTokenCat cat
   , "(p->u."
-  , map toLower fnm
-  , "_."
+  , memName fnm
+  , "."
   , render nt
   , ");\n"
   ]

source/src/BNFC/Backend/C/CFtoCSkel.hs

@@ -19,6 +19,7 @@ import Prelude hiding ((<>))
 import BNFC.CF
 import BNFC.Utils                         ( (+++), capitalize )
 import BNFC.Backend.Common.NamedVariables
+import BNFC.Backend.C.Common              ( memName )
 import Data.Char                          ( toLower )
 import Data.Either                        ( lefts )
 
@@ -166,11 +167,11 @@ prData (cat, rules)
 
 -- | Visits all the instance variables of a category.
 -- >>> let ab = Cat "Ab"
--- >>> prPrintRule (Rule "Abc" undefined [Left ab, Left ab] Parsable)
---   case is_Abc:
---     /* Code for Abc Goes Here */
---     visitAb(p->u.abc_.ab_1);
---     visitAb(p->u.abc_.ab_2);
+-- >>> prPrintRule (Rule "ABC" undefined [Left ab, Left ab] Parsable)
+--   case is_ABC:
+--     /* Code for ABC Goes Here */
+--     visitAb(p->u.aBC_.ab_1);
+--     visitAb(p->u.aBC_.ab_2);
 --     break;
 -- <BLANKLINE>
 -- >>> let ab = TokenCat "Ab"
@@ -209,8 +210,7 @@ prCat fnm (cat, vname) =
       let visitf = "visit" <> if isTokenCat cat
                        then basicFunName cat
                        else text (identCat (normCat cat))
-      in visitf <> parens ("p->u." <> text v <> "_." <> vname ) <> ";"
-    where v = map toLower fnm
+      in visitf <> parens ("p->u." <> text (memName fnm) <> "." <> vname ) <> ";"
 
 -- | The visit-function name of a basic type
 

source/src/BNFC/Backend/C/Common.hs

@@ -1,10 +1,12 @@
 -- | Common definitions for the modules of the C backend.
 
 module BNFC.Backend.C.Common
-  ( posixC
+  ( memName
+  , posixC
   ) where
 
 import Prelude
+import BNFC.Backend.Common.NamedVariables
 
 -- | Switch C to language variant that has @strdup@.
 
@@ -16,3 +18,8 @@ posixC =
   , " */"
   , "#define _POSIX_C_SOURCE 200809L"
   ]
+
+-- | Variant names in unions.
+
+memName :: String -> String
+memName s = firstLowerCase s ++ "_"

source/src/BNFC/GetCF.hs

@@ -162,9 +162,13 @@ parseCF opts target content = do
             ]
 
   -- Warn or fail if the grammar uses names not unique modulo upper/lowercase.
-  when False $
-   case nub $ filter (`notElem` nonUniqueNames) $ filter (not . isDefinedRule) $
-       concatMap List1.toList $ duplicatesOn (map toLower . wpThing) names of
+  case nub
+    . filter (`notElem` nonUniqueNames)
+    . concatMap List1.toList
+    . duplicatesOn (map toLower . wpThing)
+    . filter (not . isDefinedRule)
+    $ names
+    of
     [] -> return ()
     ns | target `elem` [ TargetJava ]
        -> dieUnlessForce $ unlines $ concat

testing/src/ParameterizedTests.hs

@@ -72,11 +72,12 @@ currentRegressionTest :: Test
 currentRegressionTest = makeTestSuite "Current parameterized test" $
   map (`makeTestCase` ("regression-tests" </> cur)) parameters
   where
+  cur = "479_LabelsCaseSensitive"
   -- cur = "comments"
   -- cur = "358_MixFixLists"
   -- cur = "289_LexerKeywords"
   -- cur = "249_unicode"
-  cur = "266_define"
+  -- cur = "266_define"
   -- cur = "235_SymbolsOverlapTokens"
   -- cur = "202_comments"
   -- cur = "278_Keywords"
@@ -192,7 +193,8 @@ testCases :: TestParameters -> [Test]
 testCases params =
     map (makeTestCase params) $
       map ("regression-tests/" ++) $
-        [ "266_define"
+        [ "479_LabelsCaseSensitive"
+        , "266_define"
         , "358_MixFixLists"
         , "235_SymbolsOverlapTokens"
         , "278_Keywords"