Check for empty entity string in "prim" foreign imports
authorSylvain HENRY <hsyl20@gmail.com>
Fri, 14 Oct 2016 14:43:30 +0000 (10:43 -0400)
committerBen Gamari <ben@smart-cactus.org>
Fri, 14 Oct 2016 17:27:33 +0000 (13:27 -0400)
Foreign imports with "prim" convention require a valid symbol identifier
(see linked issue). We check this.

Fix line too long

Test Plan: Validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2563

GHC Trac Issues: #12355

compiler/parser/RdrHsSyn.hs
testsuite/tests/codeGen/should_compile/all.T
testsuite/tests/ffi/should_fail/T10461.stderr

index 4fc1c9c..3c1792b 100644 (file)
@@ -1301,28 +1301,42 @@ mkImport :: Located CCallConv
          -> Located Safety
          -> (Located StringLiteral, Located RdrName, LHsSigType RdrName)
          -> P (HsDecl RdrName)
-mkImport (L lc cconv) (L ls safety) (L loc (StringLiteral esrc entity), v, ty)
-  | cconv == PrimCallConv                      = do
-  let funcTarget = CFunction (StaticTarget esrc entity Nothing True)
-      importSpec = CImport (L lc PrimCallConv) (L ls safety) Nothing funcTarget
-                           (L loc esrc)
-  return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty
-                              , fd_co = noForeignImportCoercionYet
-                              , fd_fi = importSpec }))
-  | cconv == JavaScriptCallConv = do
-  let funcTarget = CFunction (StaticTarget esrc entity Nothing True)
-      importSpec = CImport (L lc JavaScriptCallConv) (L ls safety) Nothing
-                           funcTarget (L loc (unpackFS entity))
-  return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty
-                              , fd_co = noForeignImportCoercionYet
-                              , fd_fi = importSpec }))
-  | otherwise = do
-    case parseCImport (L lc cconv) (L ls safety) (mkExtName (unLoc v))
-                      (unpackFS entity) (L loc (unpackFS entity)) of
-      Nothing         -> parseErrorSDoc loc (text "Malformed entity string")
-      Just importSpec -> return (ForD (ForeignImport { fd_name = v, fd_sig_ty = ty
-                                                     , fd_co = noForeignImportCoercionYet
-                                                     , fd_fi = importSpec }))
+mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
+    case cconv of
+      L _ CCallConv          -> mkCImport
+      L _ CApiConv           -> mkCImport
+      L _ StdCallConv        -> mkCImport
+      L _ PrimCallConv       -> mkOtherImport
+      L _ JavaScriptCallConv -> mkOtherImport
+  where
+    -- Parse a C-like entity string of the following form:
+    --   "[static] [chname] [&] [cid]" | "dynamic" | "wrapper"
+    -- If 'cid' is missing, the function name 'v' is used instead as symbol
+    -- name (cf section 8.5.1 in Haskell 2010 report).
+    mkCImport = do
+      let e = unpackFS entity
+      case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc e) of
+        Nothing         -> parseErrorSDoc loc (text "Malformed entity string")
+        Just importSpec -> returnSpec importSpec
+
+    -- currently, all the other import conventions only support a symbol name in
+    -- the entity string. If it is missing, we use the function name instead.
+    mkOtherImport = returnSpec importSpec
+      where
+        entity'    = if nullFS entity
+                        then mkExtName (unLoc v)
+                        else entity
+        funcTarget = CFunction (StaticTarget esrc entity' Nothing True)
+        importSpec = CImport cconv safety Nothing funcTarget (L loc esrc)
+
+    returnSpec spec = return $ ForD $ ForeignImport
+          { fd_name   = v
+          , fd_sig_ty = ty
+          , fd_co     = noForeignImportCoercionYet
+          , fd_fi     = spec
+          }
+
+
 
 -- the string "foo" is ambiguous: either a header or a C identifier.  The
 -- C identifier case comes first in the alternatives below, so we pick
index dad755e..e3fad18 100644 (file)
@@ -37,4 +37,4 @@ test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')),
                       expect_broken(11261))],
      compile, ['-g'])
 test('T12115', normal, compile, [''])
-test('T12355', when(not opsys('darwin'), expect_broken(12355)), compile, [''])
+test('T12355', normal, compile, [''])
index 7962582..fae0f50 100644 (file)
@@ -4,4 +4,4 @@ T10461.hs:6:1: error:
       ‘Word#’ cannot be marshalled in a foreign call
       To marshal unlifted types, use UnliftedFFITypes
     When checking declaration:
-      foreign import prim safe "static " cheneycopy :: Any -> Word#
+      foreign import prim safe "static cheneycopy" cheneycopy :: Any -> Word#