diff --git a/CONTRIBUTORS b/CONTRIBUTORS index 63e86eb5..61be5a8b 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -6,3 +6,4 @@ Allan Clark (allanderek) Gaute Berge (gauteab) Dimitri B. (BendingBender) pushfoo +mbartlett21 diff --git a/compiler/src/Parse/String.hs b/compiler/src/Parse/String.hs index 84d60150..d6e792fa 100644 --- a/compiler/src/Parse/String.hs +++ b/compiler/src/Parse/String.hs @@ -115,13 +115,18 @@ finalize start end revChunks = then revChunks else ES.Slice start (minusPtr end start) : revChunks -dropMultiStringEndingNewline :: [ES.Chunk] -> [ES.Chunk] -dropMultiStringEndingNewline revChunks = - case revChunks of - (ES.Escape 110) : rest -> - rest - _ -> - revChunks +finalizeMultiString :: Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> ES.String +finalizeMultiString start end revChunks = + ES.fromChunks $ + reverse $ + if start == end + then {- Get rid of ending newline before """ -} + case revChunks of + (ES.Escape 0x6E) : rest -> + rest + _ -> + revChunks + else ES.Slice start (minusPtr end start) : revChunks addEscape :: ES.Chunk -> Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> [ES.Chunk] addEscape chunk start end revChunks = @@ -179,7 +184,21 @@ multiString pos end row _ _ sr sc = then let !pos1 = plusPtr pos 1 in countLeadingWhiteSpaceThenMultiString 0 pos1 end (row + 1) 1 pos1 sr sc - else Err sr sc E.StringMultilineWithoutLeadingNewline + else + if word == 0x0D {- \r -} + then + if plusPtr pos 1 >= end + then Err sr sc E.StringEndless_Multi + else + let !word1 = P.unsafeIndex (plusPtr pos 1) + in if word1 == 0x0A {- \n -} + then + let !pos2 = plusPtr pos 2 + in countLeadingWhiteSpaceThenMultiString 0 pos2 end (row + 1) 1 pos2 sr sc + else + Err sr sc E.StringInvalidNewline + else + Err sr sc E.StringMultilineWithoutLeadingNewline countLeadingWhiteSpaceThenMultiString :: Int -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> StringResult countLeadingWhiteSpaceThenMultiString count pos end row col initialPos sr sc = @@ -214,8 +233,7 @@ multiStringBody leadingWhitespace pos end row col initialPos sr sc revChunks = in if word == 0x22 {- " -} && isDoubleQuote (plusPtr pos 1) end && isDoubleQuote (plusPtr pos 2) end then Ok (plusPtr pos 3) row (col + 3) ES.MultilineString $ - finalize initialPos pos $ - dropMultiStringEndingNewline revChunks + finalizeMultiString initialPos pos revChunks else if word == 0x27 {- ' -} then @@ -231,9 +249,17 @@ multiStringBody leadingWhitespace pos end row col initialPos sr sc revChunks = else if word == 0x0D {- \r -} then - let !pos1 = plusPtr pos 1 - in dropLeadingWhiteSpaceThenMultiString 0 leadingWhitespace pos1 end row col pos1 sr sc $ - addEscape carriageReturn initialPos pos revChunks + if plusPtr pos 1 >= end + then Err sr sc E.StringEndless_Multi + else + let !word1 = P.unsafeIndex (plusPtr pos 1) + in if word1 == 0x0A {- \n -} + then + let !pos2 = plusPtr pos 2 + in dropLeadingWhiteSpaceThenMultiString 0 leadingWhitespace pos2 end (row + 1) 1 pos2 sr sc $ + addEscape newline initialPos pos revChunks + else + Err row col E.StringInvalidNewline else if word == 0x5C {- \ -} then case eatEscape (plusPtr pos 1) end row col of @@ -308,10 +334,6 @@ newline :: ES.Chunk newline = ES.Escape 0x6E {-n-} -carriageReturn :: ES.Chunk -carriageReturn = - ES.Escape 0x72 {-r-} - placeholder :: ES.Chunk placeholder = ES.CodePoint 0xFFFD {-replacement character-} diff --git a/compiler/src/Reporting/Error/Syntax.hs b/compiler/src/Reporting/Error/Syntax.hs index 5db10e52..c2502ec3 100644 --- a/compiler/src/Reporting/Error/Syntax.hs +++ b/compiler/src/Reporting/Error/Syntax.hs @@ -442,6 +442,7 @@ data String | StringEndless_Multi | StringEscape Escape | StringMultilineWithoutLeadingNewline + | StringInvalidNewline deriving (Show) data Escape @@ -2980,13 +2981,25 @@ toStringReport source string row col = source region Nothing - ( D.reflow "The contents of a multiline sting must start on a new line", + ( D.reflow "The contents of a multiline string must start on a new line", D.stack - [ D.reflow "Add a \"\"\" a new line right after the opening quotes.", + [ D.reflow "Add a new line right after the opening quotes.", D.toSimpleNote "Here is a valid multi-line string for reference:", D.dullyellow $ D.indent 4 validMultilineStringExample ] ) + StringInvalidNewline -> + let region = toRegion row col + in Report.Report "MULTILINE STRING WITH INVALID NEWLINE" region [] $ + Code.toSnippet + source + region + Nothing + ( D.reflow "New lines in multiline strings must be either \\n or \\r\\n", + D.stack + [ D.reflow "Make sure newlines are set to either Windows (\\r\\n) or Unix (\\n)." + ] + ) validMultilineStringExample :: D.Doc validMultilineStringExample = diff --git a/tests/Parse/MultilineStringSpec.hs b/tests/Parse/MultilineStringSpec.hs index a4daef73..74badfdb 100644 --- a/tests/Parse/MultilineStringSpec.hs +++ b/tests/Parse/MultilineStringSpec.hs @@ -21,6 +21,21 @@ spec = do "normal string" "\"\"\"\nnormal string\"\"\"" + it "crlf regression test" $ do + parse + "normal string" + "\"\"\"\r\nnormal string\"\"\"" + + it "no ending newline works" $ do + parse + "this is \\na test \\nfor newlines" + "\"\"\"\nthis is \na test \nfor newlines\"\"\"" + + it "crlfs work" $ do + parse + "this is\\na test" + "\"\"\"\r\n this is\r\n a test\r\n\"\"\"" + it "mixing quotes work" $ do parse "string with \" in it" @@ -36,6 +51,16 @@ spec = do "this is\\n a test" "\"\"\"\n this is\n a test\n\"\"\"" + it "First proper line decides how many spaces to drop for crlf" $ do + parse + "this is\\n a test" + "\"\"\"\r\n this is\r\n a test\r\n\"\"\"" + + it "Works with differing lines" $ do + parse + "this is\\n a test" + "\"\"\"\n this is\r\n a test\n\"\"\"" + it "Only leading spaces are dropped" $ do parse "this is\\na test" @@ -46,6 +71,16 @@ spec = do isCorrectError _ = False Helpers.checkParseError Expression.expression ExpressionBadEnd isCorrectError "\"\"\"this is not allowed\"\"\"" + it "does not allow CR without LF on the first line" $ do + let isCorrectError ((Error.Syntax.String Error.Syntax.StringInvalidNewline _ _)) = True + isCorrectError _ = False + Helpers.checkParseError Expression.expression ExpressionBadEnd isCorrectError "\"\"\"\rthis is not allowed\"\"\"" + + it "does not allow CR without LF on the other lines" $ do + let isCorrectError ((Error.Syntax.String Error.Syntax.StringInvalidNewline _ _)) = True + isCorrectError _ = False + Helpers.checkParseError Expression.expression ExpressionBadEnd isCorrectError "\"\"\"\nthis\ris not allowed\"\"\"" + parse :: String -> BS.ByteString -> IO () parse expectedStr = let isExpectedString :: Src.Pattern_ -> Bool