From: Nathaniel Wesley Filardo <nwf@cs.jhu.edu>
Date: Sat, 8 Jun 2013 18:45:00 +0000 (-0400)
Subject: Fix a small bug in the test harness
X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=e56c80213c72cae3896362e30303a0e32c0b62e8;p=dyna2

Fix a small bug in the test harness

Thanks to Tim for the report that prop_no_unifyUnaliasedNV failed.

Rather than constrain prop_no_unifyUnaliasedNV to generate only UShared
terms, try a slightly different test in which we are unifying in a
preconstructed context.
---

diff --git a/src/Dyna/Analysis/Mode/Execution/ContextNoAlias.hs b/src/Dyna/Analysis/Mode/Execution/ContextNoAlias.hs
index 5172d21..1d1f9cf 100644
--- a/src/Dyna/Analysis/Mode/Execution/ContextNoAlias.hs
+++ b/src/Dyna/Analysis/Mode/Execution/ContextNoAlias.hs
@@ -33,10 +33,11 @@ module Dyna.Analysis.Mode.Execution.ContextNoAlias (
     -- ** Monad
     SIMCT(..), runSIMCT,
     -- *** And its context
-    SIMCtx(..), emptySIMCtx, allFreeSIMCtx,
+    SIMCtx(..), emptySIMCtx, allFreeSIMCtx, ctxFromBindings
 ) where
 
 import           Control.Applicative (Applicative)
+import           Control.Arrow (second)
 -- import           Control.Exception(assert)
 import           Control.Lens
 -- import           Control.Monad
@@ -130,6 +131,9 @@ emptySIMCtx = SIMCtx M.empty
 allFreeSIMCtx :: [DVar] -> SIMCtx f
 allFreeSIMCtx fs = SIMCtx $ M.fromList $ map (\x -> (x, VRStruct IFree)) fs
 
+ctxFromBindings :: [(DVar, NIX f)] -> SIMCtx f
+ctxFromBindings = SIMCtx . M.fromList . map (second VRName)
+
 runSIMCT :: SIMCT m f a -> SIMCtx f -> m (Either UnifFail (a, SIMCtx f))
 runSIMCT q x = runEitherT (runStateT (unSIMCT q) x)
 
diff --git a/src/Dyna/Analysis/Mode/Selftest/Contexts.hs b/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
index e3534bc..a1268aa 100644
--- a/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
+++ b/src/Dyna/Analysis/Mode/Selftest/Contexts.hs
@@ -77,10 +77,9 @@ prop_no_unifyUnaliasedNV = unifProp2 wf no_unifyUnaliasedNV lattice
 
   no_unifyUnaliasedNV n1 n2 =
     fmap fst $ runIdentity
-             $ flip CNA.runSIMCT (CNA.allFreeSIMCtx [v])
+             $ flip CNA.runSIMCT (CNA.ctxFromBindings [(v,n1)])
              $ flip runReaderT (UnifParams True False)
              $ do
-                _ <- FNA.unifyUnaliasedNV n1 v
                 _ <- FNA.unifyUnaliasedNV n2 v
                 FNA.expandV v
    where v = "A"