diff --git a/tests/ghc-regress/typecheck/should_fail/all.T b/tests/ghc-regress/typecheck/should_fail/all.T
index c7df474f6e57d3b2ba09c0bcef138339e856d734..069ca491d0f8a7b22ca281984a02ebafbd9ae872 100644
--- a/tests/ghc-regress/typecheck/should_fail/all.T
+++ b/tests/ghc-regress/typecheck/should_fail/all.T
@@ -122,7 +122,10 @@ test('tcfail134', normal, compile_fail, [''])
 test('tcfail135', normal, compile_fail, [''])
 test('tcfail136', normal, compile_fail, [''])
 test('tcfail137', normal, compile_fail, [''])
-test('tcfail138', normal, compile_fail, [''])
+
+test('tcfail138', normal, compile, [''])
+# Now works; see notes in file
+
 test('tcfail139', normal, compile_fail, [''])
 test('tcfail140', expect_broken(451), compile_fail, [''])
 test('tcfail141', only_compiler_types(['ghc']), compile_fail, [''])
diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail138.hs b/tests/ghc-regress/typecheck/should_fail/tcfail138.hs
index aa05dc8bdd91040818952eb89d6e1a8f5dbeeea3..18ded5c91bdd969843c0d54405a538f586685e5e 100644
--- a/tests/ghc-regress/typecheck/should_fail/tcfail138.hs
+++ b/tests/ghc-regress/typecheck/should_fail/tcfail138.hs
@@ -19,6 +19,12 @@
 -- So, today, this program fails.  It's trivial to fix by adding a fundep for C
 -- 	class (G a, L a b) => C a b | a -> b
 
+-- Note: Sept 08: when fixing Trac #1470, tc138 started working! 
+-- This test is a very strange one (fundeps, undecidable instances), 
+-- so I'm just marking it as "should-succeed".  It's not very clear to
+-- me what the "right" answer should be; when we have the type equality
+-- story more worked out we might want to think about that.
+
 module ShouldFail where
 
 class G a
diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail138.stderr b/tests/ghc-regress/typecheck/should_fail/tcfail138.stderr
index 36eb4dd49d2f03c052196a287bfd3c3e0c1f9970..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644
--- a/tests/ghc-regress/typecheck/should_fail/tcfail138.stderr
+++ b/tests/ghc-regress/typecheck/should_fail/tcfail138.stderr
@@ -1,8 +0,0 @@
-
-tcfail138.hs:29:9:
-    Could not deduce (C a b') from the context (C a b)
-      arising from the superclasses of an instance declaration
-                   at tcfail138.hs:29:9-31
-    Possible fix:
-      add (C a b') to the context of the instance declaration
-    In the instance declaration for `C (Maybe a) a'