Fix naming issue in totality checker

Also added a new test

src/Core/Termination.idr

@@ -17,7 +17,8 @@ import Debug.Trace
 %default covering
 
 -- Check that the names a function refers to are terminating
-totRefs : Defs -> List Name -> Core Terminating
+totRefs : {auto c : Ref Ctxt Defs} ->
+          Defs -> List Name -> Core Terminating
 totRefs defs [] = pure IsTerminating
 totRefs defs (n :: ns)
     = do rest <- totRefs defs ns
@@ -28,10 +29,11 @@ totRefs defs (n :: ns)
               Unchecked => pure rest
               bad => case rest of
                           NotTerminating (BadCall ns)
-                             => pure $ NotTerminating (BadCall (n :: ns))
-                          _ => pure $ NotTerminating (BadCall [n])
+                             => toFullNames $ NotTerminating (BadCall (n :: ns))
+                          _ => toFullNames $ NotTerminating (BadCall [n])
 
-totRefsIn : Defs -> Term vars -> Core Terminating
+totRefsIn : {auto c : Ref Ctxt Defs} ->
+            Defs -> Term vars -> Core Terminating
 totRefsIn defs ty = totRefs defs (keys (getRefs ty))
 
 -- Equal for the purposes of size change means, ignoring as patterns, all
@@ -419,15 +421,21 @@ calcTerminating loc n
                            checkSC defs n args []
                      bad => pure bad
   where
+    addCases' : Defs -> NameMap () -> List Name -> Core (List Name)
+    addCases' defs all [] = pure (keys all)
+    addCases' defs all (n :: ns)
+        = case lookup n all of
+             Just _ => addCases' defs all ns
+             Nothing =>
+               if caseFn !(getFullName n)
+                  then case !(lookupCtxtExact n (gamma defs)) of
+                            Just def => addCases' defs (insert n () all)
+                                                  (keys (refersTo def) ++ ns)
+                            Nothing => addCases' defs (insert n () all) ns
+                  else addCases' defs (insert n () all) ns
+
     addCases : Defs -> List Name -> Core (List Name)
-    addCases defs [] = pure []
-    addCases defs (n :: ns)
-        = if caseFn n
-             then case !(lookupCtxtExact n (gamma defs)) of
-                       Just def => pure $ n :: keys (refersTo def) ++ !(addCases defs ns)
-                       Nothing => pure $ n :: !(addCases defs ns)
-             else do ns' <- addCases defs ns
-                     pure $ n :: ns'
+    addCases defs ns = addCases' defs empty ns
 
 -- Check whether a function is terminating, and record in the context
 export
@@ -500,7 +508,8 @@ checkPosArgs defs tyns (NBind fc x (Pi c e ty) sc)
            bad => pure bad
 checkPosArgs defs tyns _ = pure IsTerminating
 
-checkCon : Defs -> List Name -> Name -> Core Terminating
+checkCon : {auto c : Ref Ctxt Defs} ->
+           Defs -> List Name -> Name -> Core Terminating
 checkCon defs tyns cn 
     = case !(lookupTyExact cn (gamma defs)) of
            Nothing => pure Unchecked
@@ -509,7 +518,8 @@ checkCon defs tyns cn
                      IsTerminating => checkPosArgs defs tyns !(nf defs [] ty)
                      bad => pure bad
 
-checkData : Defs -> List Name -> List Name -> Core Terminating
+checkData : {auto c : Ref Ctxt Defs} ->
+            Defs -> List Name -> List Name -> Core Terminating
 checkData defs tyns [] = pure IsTerminating
 checkData defs tyns (c :: cs)
     = case !(checkCon defs tyns c) of

tests/Main.idr

@@ -33,7 +33,7 @@ idrisTests
        "import001", "import002",
        "lazy001",
        "record001", "record002",
-       "total001", "total002", "total003", "total004"]
+       "total001", "total002", "total003", "total004", "total005"]
 
 chdir : String -> IO Bool
 chdir dir 

tests/idris2/total005/Total.idr

@@ -0,0 +1,21 @@
+data Bad = MkBad (Bad -> Int) Int
+         | MkBad' Int
+
+foo : Bad -> Int
+foo (MkBad f i) = f (MkBad' i)
+foo (MkBad' x) = x
+
+foo2 : Bad -> Int
+foo2 b = case b of
+              MkBad f i => f (MkBad' i)
+              MkBad' x => x
+
+data T : Type -> Type where
+     MkT : T (T a) -> T a
+
+mutual
+  data Bad1 = MkBad1 (Bad2 -> Int)
+  data Bad2 = MkBad2 (Bad1 -> Int)
+
+data T2 : Type -> Type where
+     MkT2 : T a -> T2 a

tests/idris2/total005/expected

@@ -0,0 +1,10 @@
+1/1: Building Total (Total.idr)
+Welcome to Idris 2 version 0.0. Enjoy yourself!
+Main> Main.Bad is not strictly positive
+Main> Main.Bad1 is not strictly positive
+Main> Main.Bad2 is not terminating due to call to Main.Bad1
+Main> Main.foo is not terminating due to calls to Main.MkBad', Main.MkBad
+Main> Main.foo2 is not terminating due to calls to Main.MkBad', Main.MkBad
+Main> Main.T is not strictly positive
+Main> Main.T2 is not terminating due to call to Main.T
+Main> Bye for now!

tests/idris2/total005/input

@@ -0,0 +1,8 @@
+:total Bad
+:total Bad1
+:total Bad2
+:total foo
+:total foo2
+:total T
+:total T2
+:q

tests/idris2/total005/run

@@ -0,0 +1,3 @@
+$1 Total.idr < input
+
+rm -rf build

tests/ttimp/total003/expected

@@ -3,6 +3,6 @@ Written TTC
 Yaffle> Main.Bad is not strictly positive
 Yaffle> Main.MkBad is not strictly positive
 Yaffle> Main.MkBad' is not strictly positive
-Yaffle> Main.foo is not terminating due to calls to $resolved71, $resolved72
+Yaffle> Main.foo is not terminating due to calls to Main.MkBad, Main.MkBad'
 Yaffle> Main.T is not strictly positive
 Yaffle> Bye for now!