[commit: ghc] master: Deal with JoinIds before void types (bc0f3ab)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/bc0f3abd0914808e33f84229818ab90842611bdd/ghc

>---------------------------------------------------------------

commit bc0f3abd0914808e33f84229818ab90842611bdd
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Mar 10 11:12:12 2017 +0000

    Deal with JoinIds before void types
    
    Trac #13394, comment:4 showed up another place where we were testing
    for the representation of of a type; and it turned out to be a JoinId
    which can be rep-polymorphic.
    
    Just putting the test in the right places solves this easily.


>---------------------------------------------------------------

bc0f3abd0914808e33f84229818ab90842611bdd
 compiler/codeGen/StgCmmExpr.hs                      | 7 ++++---
 testsuite/tests/polykinds/{T13394.hs => T13394a.hs} | 2 +-
 testsuite/tests/polykinds/all.T                     | 1 +
 3 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 395e8d6..39edd05 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -701,7 +701,6 @@ cgConApp con stg_args
         ; emitReturn [idInfoToAmode idinfo] }
 
 cgIdApp :: Id -> [StgArg] -> FCode ReturnKind
-cgIdApp fun_id [] | isVoidTy (idType fun_id) = emitReturn []
 cgIdApp fun_id args = do
     dflags         <- getDynFlags
     fun_info       <- getCgIdInfo fun_id
@@ -719,9 +718,11 @@ cgIdApp fun_id args = do
         v_args      = length $ filter (isVoidTy . stgArgType) args
         node_points dflags = nodeMustPointToIt dflags lf_info
     case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of
-
             -- A value in WHNF, so we can just return it.
-        ReturnIt -> emitReturn [fun] -- ToDo: does ReturnIt guarantee tagged?
+        ReturnIt
+          | isVoidTy (idType fun_id) -> emitReturn []
+          | otherwise                -> emitReturn [fun]
+          -- ToDo: does ReturnIt guarantee tagged?
 
         EnterIt -> ASSERT( null args )  -- Discarding arguments
                    emitEnter fun
diff --git a/testsuite/tests/polykinds/T13394.hs b/testsuite/tests/polykinds/T13394a.hs
similarity index 84%
copy from testsuite/tests/polykinds/T13394.hs
copy to testsuite/tests/polykinds/T13394a.hs
index 88c482a..e79bf79 100644
--- a/testsuite/tests/polykinds/T13394.hs
+++ b/testsuite/tests/polykinds/T13394a.hs
@@ -12,4 +12,4 @@ newtype ProperName =
 newtype ModuleName = ModuleName [ProperName]
 
 pattern TypeDataSymbol :: ModuleName
-pattern TypeDataSymbol = ModuleName [ProperName "Type"]
+pattern TypeDataSymbol = ModuleName [ProperName "Type", ProperName "Data"]
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 8dd27b0..e8a0fac 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -155,4 +155,5 @@ test('T12718', normal, compile, [''])
 test('T12444', normal, compile_fail, [''])
 test('T12885', normal, compile, [''])
 test('T13267', normal, compile_fail, [''])
+test('T13394a', normal, compile, [''])
 test('T13394', normal, compile, [''])