Fix lexing hash directives and raise errors (2nd attempt) - several cases

src/fsharp/LexFilter.fs

@@ -2215,6 +2215,13 @@ type LexFilterImpl (lightStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbu
 
     and rulesForBothSoftWhiteAndHardWhite(tokenTup: TokenTup) = 
           match tokenTup.Token with 
+          | HASH_IDENT (ident) ->
+              let hashPos = new LexbufState(tokenTup.StartPos, tokenTup.StartPos.ShiftColumnBy(1), false)
+              let identPos = new LexbufState(tokenTup.StartPos.ShiftColumnBy(1), tokenTup.EndPos, false)
+              delayToken(new TokenTup(IDENT(ident), identPos, tokenTup.LastTokenPos))
+              delayToken(new TokenTup(HASH, hashPos, tokenTup.LastTokenPos))
+              true
+
           // Insert HIGH_PRECEDENCE_PAREN_APP if needed 
           | IDENT _ when (nextTokenIsAdjacentLParenOrLBrack tokenTup).IsSome ->
               let dotTokenTup = peekNextTokenTup()

src/fsharp/lex.fsl

@@ -895,8 +895,10 @@ rule token args skip = parse
  | "#light" anywhite* 
  | ("#indent" | "#light") anywhite+ "\"on\""
    { if args.lightStatus.ExplicitlySet && args.lightStatus.WarnOnMultipleTokens then 
-         warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"), lexbuf.LexemeRange))
-     // TODO unreachable error above, I think? - brianmcn 
+         let s = lexeme lexbuf
+         warning(Error((0, sprintf "%s should only be set once in an F# source file." s), lexbuf.LexemeRange))
+         // TODO: where should this go? (abelb)
+         //warning(Error((0,"#light should only occur as the first non-comment text in an F# source file."), lexbuf.LexemeRange))
      args.lightStatus.Status <- true 
      if not skip then HASH_LIGHT (LexCont.Token(args.ifdefStack, args.stringNest))
      else token args skip lexbuf } 
@@ -956,6 +958,14 @@ rule token args skip = parse
      let tok = fail args lexbuf (FSComp.SR.lexHashIfMustHaveIdent()) tok 
      if not skip then tok else token args skip lexbuf }
 
+ | anywhite* "#if" ident_char+
+ | anywhite* "#else" ident_char+
+ | anywhite* "#endif" ident_char+
+ | anywhite* "#light" ident_char+
+   { let n = Array.IndexOf(lexbuf.Lexeme, '#')
+     lexbuf.StartPos <- lexbuf.StartPos.ShiftColumnBy(n)
+     HASH_IDENT(lexemeTrimLeft lexbuf (n+1)) }
+
  | surrogateChar surrogateChar
 
  | _ 

src/fsharp/pars.fsy

@@ -201,6 +201,7 @@ let rangeOfLongIdent(lid:LongIdent) =
 
 %token <string> KEYWORD_STRING // Like __SOURCE_DIRECTORY__
 %token <string> IDENT 
+%token <string> HASH_IDENT 
 %token <string> INFIX_STAR_STAR_OP 
 %token <string> INFIX_COMPARE_OP 
 %token <string> INFIX_AT_HAT_OP 

src/fsharp/service/ServiceLexing.fs

@@ -32,6 +32,7 @@ module FSharpTokenTag =
     let String = tagOfToken (STRING ("a", LexCont.Default))
 
     let IDENT = tagOfToken (IDENT "a")
+    let HASH_IDENT = tagOfToken (HASH_IDENT "a")
     let STRING = String
     let INTERP_STRING_BEGIN_END = tagOfToken (INTERP_STRING_BEGIN_END ("a", LexCont.Default))
     let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART ("a", LexCont.Default))
@@ -172,6 +173,7 @@ module internal TokenClassifications =
 
     let tokenInfo token =
         match token with
+        | HASH_IDENT s
         | IDENT s ->
             if s.Length <= 0 then
                 System.Diagnostics.Debug.Assert(false, "BUG: Received zero length IDENT token.")
@@ -773,6 +775,9 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
                     false, processHashEndElse m.StartColumn lineStr 4 cont
                 | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" ->
                     false, processHashEndElse m.StartColumn lineStr 5 cont
+                | HASH_IDENT(ident) ->
+                    delayToken(IDENT (ident), leftc + 1, rightc)
+                    false, (HASH, leftc, leftc)
                 | RQUOTE_DOT (s, raw) ->
                     delayToken(DOT, rightc, rightc)
                     false, (RQUOTE (s, raw), leftc, rightc - 1)

tests/fsharpqa/Source/Conformance/LexicalAnalysis/ConditionalCompilation/E_MustBeIdent02.fs

@@ -1,10 +1,9 @@
-// #Regression #Conformance #LexicalAnalysis 
+// #Regression #Conformance #LexicalAnalysis
 // Regression test for FSHARP1.0:1419
-//<Expects id="FS1169" span="(7,13-7,16)" status="error">#if directive should be immediately followed by an identifier</Expects>
-//<Expects id="FS0010" span="(8,12-8,19)" status="error">#endif has no matching #if in pattern</Expects>
-//<Expects id="FS0583" span="(8,8-8,9)" status="error">Unmatched '\('</Expects>
+//<Expects id="FS0039" span="(6,14-6,17)" status="error">The type 'if_' is not defined.</Expects>
+//<Expects id="FS0039" span="(7,14-7,20)" status="error">The type 'endif_' is not defined.</Expects>
 #light
 let t8 (x : #if_) = ()
 let t7 (x : #endif_) = ()
 
-exit 1
+exit 1

tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/HashConstraint02.fs

@@ -1,8 +1,7 @@
 // #Regression #Conformance #TypeConstraints 
 // Regression test for FSHARP1.0:1419
 // Tokens beginning with # should not match greedily with directives
-// The only case where we are still a bit confused is #light: for this reason the code
-// below compiles just fine (it would not work if I replace #light with #r for example)
+//<Expects id="FS0001" span="(14,13)" status="error">The type 'float' is not compatible with the type 'light_'</Expects>
 #light
 
 type light_() = class

vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Miscellaneous.fs

@@ -266,8 +266,7 @@ type Miscellaneous() =
              this.MSBuildProjectBoilerplate "Library", 
              (fun project ccn projFileName ->
                 let fooPath = Path.Combine(project.ProjectFolder, "foo.fs")
-                File.AppendAllText(fooPath, "#light")
-                File.AppendAllText(fooPath, "module Foo")
+                File.AppendAllLines(fooPath, ["#light"; "module Foo"])
 
                 //ccn((project :> IVsHierarchy), "Debug|Any CPU")
                 let configName = "Debug"                
@@ -278,6 +277,7 @@ type Miscellaneous() =
                 let buildableCfg = vsBuildableCfg :?> BuildableProjectConfig
                 AssertEqual VSConstants.S_OK hr
 
+                let mutable isCleaning = false
                 let success = ref false
                 use event = new System.Threading.ManualResetEvent(false)
                 let (hr, cookie) = 
@@ -286,6 +286,8 @@ type Miscellaneous() =
                             member this.BuildBegin pfContinue = pfContinue <- 1; VSConstants.S_OK
                             member this.BuildEnd fSuccess =
                                 success := fSuccess <> 0
+                                printfn "Build %s, code %i, phase: %s." (if !success then "succeeded" else "failed") fSuccess (if isCleaning then "Cleaning" else "Build")
+
                                 event.Set() |> Assert.IsTrue
                                 VSConstants.S_OK
                             member this.Tick pfContinue = pfContinue <- 1; VSConstants.S_OK
@@ -301,14 +303,19 @@ type Miscellaneous() =
                         buildableCfg.Build(0u, output, target)
                         event.WaitOne() |> Assert.IsTrue
                         buildMgrAccessor.EndDesignTimeBuild() |> ValidateOK // this is not a design-time build, but our mock does all the right initialization of the build manager for us, similar to what the system would do in VS for real
-                        AssertEqual true !success    
-                    printfn "building..."
-                    doBuild "Build"                    
+                        AssertEqual true !success
+
+                    printfn "Building..."
+                    doBuild "Build"
                     AssertEqual true (File.Exists (Path.Combine(project.ProjectFolder, "bin\\Debug\\Blah.dll")))
+                    printfn "Output files present."
 
-                    printfn "cleaning..."
+                    isCleaning <- true
+                    printfn "Cleaning..."
                     doBuild "Clean"
+                    printfn "Finished build-then-clean."
                     AssertEqual false (File.Exists (Path.Combine(project.ProjectFolder, "bin\\Debug\\Blah.dll")))
+                    printfn "Files were cleaned."
                 finally
                     buildableCfg.UnadviseBuildStatusCallback(cookie) |> AssertEqual VSConstants.S_OK
         ))