Commit 5971ad56 authored by thomie's avatar thomie
Browse files

Syntax check package-qualified imports (#9225)

Version numbers are not allowed in the package name of a
package-qualified import.

Reviewed By: austin, ezyang

Differential Revision: https://phabricator.haskell.org/D755
parent b1d6a608
...@@ -84,6 +84,9 @@ import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataC ...@@ -84,6 +84,9 @@ import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataC
unboxedUnitTyCon, unboxedUnitDataCon, unboxedUnitTyCon, unboxedUnitDataCon,
listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR ) listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR, eqTyCon_RDR )
-- compiler/utils
import Util ( looksLikePackageName )
} }
{- Last updated: 03 Mar 2015 {- Last updated: 03 Mar 2015
...@@ -774,8 +777,13 @@ maybe_safe :: { ([AddAnn],Bool) } ...@@ -774,8 +777,13 @@ maybe_safe :: { ([AddAnn],Bool) }
| {- empty -} { ([],False) } | {- empty -} { ([],False) }
maybe_pkg :: { ([AddAnn],Maybe FastString) } maybe_pkg :: { ([AddAnn],Maybe FastString) }
: STRING { ([mj AnnPackageName $1] : STRING {% let pkgFS = getSTRING $1 in
,Just (getSTRING $1)) } if looksLikePackageName (unpackFS pkgFS)
then return ([mj AnnPackageName $1], Just pkgFS)
else parseErrorSDoc (getLoc $1) $ vcat [
text "parse error" <> colon <+> quotes (ppr pkgFS),
text "Version number or non-alphanumeric" <+>
text "character in package name"] }
| {- empty -} { ([],Nothing) } | {- empty -} { ([],Nothing) }
optqualified :: { ([AddAnn],Bool) } optqualified :: { ([AddAnn],Bool) }
......
...@@ -67,6 +67,7 @@ module Util ( ...@@ -67,6 +67,7 @@ module Util (
-- * Module names -- * Module names
looksLikeModuleName, looksLikeModuleName,
looksLikePackageName,
-- * Argument processing -- * Argument processing
getCmd, toCmdArgs, toArgs, getCmd, toCmdArgs, toArgs,
...@@ -115,6 +116,10 @@ import Data.List hiding (group) ...@@ -115,6 +116,10 @@ import Data.List hiding (group)
import FastTypes import FastTypes
#endif #endif
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative)
#endif
import Control.Applicative ( liftA2 )
import Control.Monad ( liftM ) import Control.Monad ( liftM )
import System.IO.Error as IO ( isDoesNotExistError ) import System.IO.Error as IO ( isDoesNotExistError )
import System.Directory ( doesDirectoryExist, getModificationTime ) import System.Directory ( doesDirectoryExist, getModificationTime )
...@@ -655,6 +660,11 @@ cmpList cmp (a:as) (b:bs) ...@@ -655,6 +660,11 @@ cmpList cmp (a:as) (b:bs)
removeSpaces :: String -> String removeSpaces :: String -> String
removeSpaces = dropWhileEndLE isSpace . dropWhile isSpace removeSpaces = dropWhileEndLE isSpace . dropWhile isSpace
-- Boolean operators lifted to Applicative
(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
(<&&>) = liftA2 (&&)
infixr 3 <&&> -- same as (&&)
{- {-
************************************************************************ ************************************************************************
* * * *
...@@ -822,6 +832,11 @@ looksLikeModuleName (c:cs) = isUpper c && go cs ...@@ -822,6 +832,11 @@ looksLikeModuleName (c:cs) = isUpper c && go cs
go ('.':cs) = looksLikeModuleName cs go ('.':cs) = looksLikeModuleName cs
go (c:cs) = (isAlphaNum c || c == '_' || c == '\'') && go cs go (c:cs) = (isAlphaNum c || c == '_' || c == '\'') && go cs
-- Similar to 'parse' for Distribution.Package.PackageName,
-- but we don't want to depend on Cabal.
looksLikePackageName :: String -> Bool
looksLikePackageName = all (all isAlphaNum <&&> not . (all isDigit)) . split '-'
{- {-
Akin to @Prelude.words@, but acts like the Bourne shell, treating Akin to @Prelude.words@, but acts like the Bourne shell, treating
quoted strings as Haskell Strings, and also parses Haskell [String] quoted strings as Haskell Strings, and also parses Haskell [String]
......
module T9225 where
-- Should be a parse error:
-- version numbers not allowed in package qualified imports
import "some-package-0.1.2.3" Some.Module
T9225.hs:4:8:
parse error: ‘some-package-0.1.2.3’
Version number or non-alphanumeric character in package name
...@@ -86,3 +86,4 @@ test('ExportCommaComma', normal, compile_fail, ['']) ...@@ -86,3 +86,4 @@ test('ExportCommaComma', normal, compile_fail, [''])
test('T8430', literate, compile_fail, ['']) test('T8430', literate, compile_fail, [''])
test('T8431', [timeout_multiplier(0.05)], compile_fail, ['-XAlternativeLayoutRule']) test('T8431', [timeout_multiplier(0.05)], compile_fail, ['-XAlternativeLayoutRule'])
test('T8506', normal, compile_fail, ['']) test('T8506', normal, compile_fail, [''])
test('T9225', normal, compile_fail, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment