[add self testing for Name, make Name more stingy about what it accepts
John Meacham <john@repetae.net>**20050914031639] hunk ./Name.hs 81
+createName _ "" i = error $ "createName: empty module "  ++ i
+createName _ m "" = error $ "createName: empty ident "   ++ m
+createName t m i = Name $  toAtom $ (chr $ fromEnum t):m ++ "\NUL" ++ i
+createUName _ "" = error $ "createUName: empty ident"
+createUName t i =  Name $ toAtom $ (chr $ fromEnum t):"\NUL" ++ i
+
hunk ./Name.hs 92
-    toName nt n = Name $ toAtom $ (chr $ fromEnum nt):m ++ "\NUL" ++ i where
+    toName nt n = m where
hunk ./Name.hs 94
-        m | Qual (Module m) _ <- n = m
-          | otherwise = ""
+        m | Qual (Module m) _ <- n = createName nt m i
+          | otherwise = createUName nt i
hunk ./Name.hs 99
-    toName nt (m,i) = Name $ toAtom $ (chr $ fromEnum nt):m ++ "\NUL" ++ i
+    toName nt (m,i) = createName nt m i
hunk ./Name.hs 106
-    toName nt i = Name $ toAtom $ (chr $ fromEnum nt):"\NUL" ++ i
+    toName nt i = createUName nt i
hunk ./Name.hs 133
-parseName t name = toName t (concatInter "." ms, concatInter "." (ns ++ [last sn])) where
+parseName t name = if not (null ms) then toName t (concatInter "." ms, concatInter "." (ns ++ [last sn])) else toName t (concatInter "." (ns ++ [last sn])) where
hunk ./SelfTest.hs 9
+import Name
+import HsSyn
hunk ./SelfTest.hs 22
+    testName
hunk ./SelfTest.hs 37
+testName = do
+    putStrLn "Testing Name"
+    let nn = not . null
+    let prop_tofrom t a b = nn a && nn b ==> fromName (toName t (a::String,b::String)) == (t,(a,b))
+        prop_pn t s = nn s ==> let (a,b) = fromName (parseName t s) in (a,b) == (t,s)
+        prop_acc t a b = nn a && nn b ==> let
+            n = toName t (a::String,b::String)
+            un = toUnqualified n
+            in  nameType n == t && getModule n == Just (Module a) && getModule un == Nothing && show un == b && show n == (a ++ "." ++ b)
+        prop_tup n = n >= 0 ==> fromUnboxedNameTuple (unboxedNameTuple RawType n) == Just n
+    quickCheck prop_tofrom
+    quickCheck prop_pn
+    quickCheck prop_acc
+    quickCheck prop_tup
+
+
hunk ./SelfTest.hs 78
+
+
+instance Arbitrary NameType where
+    arbitrary = oneof $ map return [ TypeConstructor .. ] -- ,  DataConstructor, ClassName, TypeVal, Val, SortName, FieldLabel, RawType]