]> hydra-www.ietfng.org Git - dyna2/commitdiff
Fix a small bug in the test harness
authorNathaniel Wesley Filardo <nwf@cs.jhu.edu>
Sat, 8 Jun 2013 18:45:00 +0000 (14:45 -0400)
committerNathaniel Wesley Filardo <nwf@cs.jhu.edu>
Sat, 8 Jun 2013 18:45:00 +0000 (14:45 -0400)
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.

src/Dyna/Analysis/Mode/Execution/ContextNoAlias.hs
src/Dyna/Analysis/Mode/Selftest/Contexts.hs

index 5172d21f8e06ac88586c22ad6eb167c1cea5fa81..1d1f9cf51bd928e993505b513ae3ac6313c266cd 100644 (file)
@@ -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)
 
index e3534bc517d0e9b91d9241fdc4805df4c177efad..a1268aa7a6dce76a51185cf436026e46553be27f 100644 (file)
@@ -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"