Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/942939c050b0649430a2e41b026499efb46d5f17 >--------------------------------------------------------------- commit 942939c050b0649430a2e41b026499efb46d5f17 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Dec 19 13:23:21 2012 +0000 Fix Trac #7506 (missing check for form of FFI type) >--------------------------------------------------------------- compiler/typecheck/TcForeign.lhs | 12 ++++++++---- 1 files changed, 8 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index 40fb3b2..c691bd0 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -47,7 +47,6 @@ import Platform import SrcLoc import Bag import FastString -import Util import Control.Monad \end{code} @@ -213,11 +212,11 @@ tcFImport d = pprPanic "tcFImport" (ppr d) tcCheckFIType :: Type -> [Type] -> Type -> ForeignImport -> TcM ForeignImport tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh l@(CLabel _)) - = ASSERT( null arg_tys ) - do checkCg checkCOrAsmOrLlvmOrInterp + -- Foreign import label + = do checkCg checkCOrAsmOrLlvmOrInterp -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) - check (isFFILabelTy res_ty) (illegalForeignTyErr empty sig_ty) + check (null arg_tys && isFFILabelTy res_ty) (illegalForeignLabelErr sig_ty) cconv' <- checkCConv cconv return (CImport cconv' safety mh l) @@ -483,6 +482,11 @@ check :: Bool -> MsgDoc -> TcM () check True _ = return () check _ the_err = addErrTc the_err +illegalForeignLabelErr :: Type -> SDoc +illegalForeignLabelErr ty + = vcat [ illegalForeignTyErr empty ty + , ptext (sLit "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)") ] + illegalForeignTyErr :: SDoc -> Type -> SDoc illegalForeignTyErr arg_or_res ty = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res, _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
