Test culture insensivity and bug fixes

Naggum.Backend/Reader.fs

@@ -41,7 +41,7 @@ let string =
     let normalChar = satisfy (fun c -> c <> '\"')
     between (pstring "\"") (pstring "\"") (manyChars normalChar) |>> (fun str -> str :> obj) |>> Object
 
-let symChars = (anyOf "+-*/=<>!?.") //chars that are valid in the symbol name
+let symChars = (anyOf "+-*/=<>!?._") //chars that are valid in the symbol name
 let symbol = (many1Chars (letter <|> digit <|> symChars)) |>> Symbol
 let atom = (pnumber <|> string <|> symbol) |>> Atom
 let listElement = choice [ atom; list ]

Naggum.Compiler/FormGenerator.fs

@@ -59,19 +59,19 @@ type SequenceGenerator(context:Context,typeBuilder:TypeBuilder,seq:SExp list, gf
             List.map (fun (sexp) -> List.head ((gf.MakeGenerator context sexp).ReturnTypes())) seq
 
 type BodyGenerator(context : Context,
-                   methodBuilder : MethodBuilder,
+                   resultType : Type,
                    body : SExp list,
                    gf : IGeneratorFactory) =
     let rec genBody (ilGen : ILGenerator) (body : SExp list) =
         match body with
             | [] ->
-                ilGen.Emit(OpCodes.Ldnull)
+                if resultType <> typeof<Void> then
+                    ilGen.Emit(OpCodes.Ldnull)
             | [last] ->
                 let gen = gf.MakeGenerator context last
                 let stackType = List.head <| gen.ReturnTypes ()
-                let returnType = methodBuilder.ReturnType
                 gen.Generate ilGen
-                match (stackType, returnType) with
+                match (stackType, resultType) with
                 | (s, r) when s = typeof<Void> && r = typeof<Void> -> ()
                 | (s, r) when s = typeof<Void> && r <> typeof<Void> -> ilGen.Emit OpCodes.Ldnull
                 | (s, r) when s <> typeof<Void> && r = typeof<Void> -> ilGen.Emit OpCodes.Pop
@@ -86,18 +86,13 @@ type BodyGenerator(context : Context,
     interface IGenerator with
         member __.Generate ilGen =
             genBody ilGen body
-        member this.ReturnTypes () =
+        member __.ReturnTypes () =
             match body with
-            |[] -> [typeof<System.Void>]
-            |somelist ->
-                let tail_type = (gf.MakeGenerator context (List.rev body |> List.head)).ReturnTypes()
-                if tail_type = [typeof<System.Void>] then
-                    [typeof<obj>]
-                else tail_type
+            | [] -> [typeof<System.Void>]
+            | _ -> (gf.MakeGenerator context (List.rev body |> List.head)).ReturnTypes()
 
 type LetGenerator(context : Context,
-                  typeBuilder : TypeBuilder,
-                  methodBuilder : MethodBuilder,
+                  resultType : Type,
                   bindings:SExp,
                   body : SExp list,
                   gf : IGeneratorFactory) =
@@ -118,7 +113,7 @@ type LetGenerator(context : Context,
                         ilGen.Emit (OpCodes.Stloc,local)
                     | other -> failwithf "In let bindings: Expected: (name (form))\nGot: %A\n" other
             | other -> failwithf "In let form: expected: list of bindings\nGot: %A" other
-            let bodyGen = new BodyGenerator (scope_subctx, methodBuilder, body, gf) :> IGenerator
+            let bodyGen = new BodyGenerator (scope_subctx, resultType, body, gf) :> IGenerator
             bodyGen.Generate ilGen
             ilGen.EndScope()
         member this.ReturnTypes () =

Naggum.Compiler/GeneratorFactory.fs

@@ -48,12 +48,11 @@ type GeneratorFactory(typeBuilder : TypeBuilder,
         | [Symbol "if"; condition; if_true] -> // reduced if form
             new ReducedIfGenerator(context,typeBuilder,condition,if_true,this) :> IGenerator
         | Symbol "let" :: bindings :: body -> // let form
-            new LetGenerator(context,
-                             typeBuilder,
-                             methodBuilder,
-                             bindings,
-                             body,
-                             this) :> IGenerator
+            upcast new LetGenerator(context,
+                                    typeof<Void>,
+                                    bindings,
+                                    body,
+                                    this)
         | [Symbol "quote"; quotedExp] ->
             new QuoteGenerator(context,typeBuilder,quotedExp,this) :> IGenerator
         | Symbol "new" :: Symbol typeName :: args ->
@@ -102,10 +101,7 @@ type GeneratorFactory(typeBuilder : TypeBuilder,
         new SequenceGenerator(context,typeBuilder,seq,(this :> IGeneratorFactory))
 
     member private this.makeBodyGenerator(context: Context,body:SExp list) =
-        new BodyGenerator(context,
-                          methodBuilder,
-                          body,
-                          (this :> IGeneratorFactory))
+        new BodyGenerator(context, methodBuilder.ReturnType, body, this)
 
     interface IGeneratorFactory with
         member this.MakeGenerator context sexp =

Naggum.Compiler/Naggum.Compiler.fsproj

@@ -28,7 +28,7 @@
     <WarningLevel>3</WarningLevel>
     <PlatformTarget>AnyCPU</PlatformTarget>
     <DocumentationFile>bin\Debug\Naggum.Compiler.XML</DocumentationFile>
-    <StartArguments>..\tests\test.naggum</StartArguments>
+    <StartArguments>..\..\..\tests\test.naggum</StartArguments>
   </PropertyGroup>
   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
     <DebugType>pdbonly</DebugType>
@@ -105,4 +105,4 @@
 	<Target Name="AfterBuild">
 	</Target>
 	-->
-</Project>
+</Project>

Naggum.Test/CompilerTest.fs

@@ -12,9 +12,9 @@ type CompilerTest() =
     static let testExtension = "naggum"
     static let resultExtension = "result"
     static let executableExtension = "exe"
-    
+
     static let directory = Path.Combine ("..", "..", "..", "tests")
-    static let filenames = [@"comment"; @"test"]
+    static let filenames = [@"comment"; @"test"; "let-funcall"]
 
     static member private RunTest testName =
         let basePath = Path.Combine(directory, testName)

Naggum.sln

@@ -7,6 +7,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Test programs", "Test progr
 	ProjectSection(SolutionItems) = preProject
 		tests\comment.naggum = tests\comment.naggum
 		tests\comment.result = tests\comment.result
+		tests\let-funcall.naggum = tests\let-funcall.naggum
+		tests\let-funcall.result = tests\let-funcall.result
 		tests\test.naggum = tests\test.naggum
 		tests\test.result = tests\test.result
 	EndProjectSection

tests/let-funcall.naggum

@@ -0,0 +1,12 @@
+(defun test-let ()
+  (System.Console.Write "Let: ")
+  (let ((ok "OK"))
+    (System.Console.WriteLine ok)))
+(System.Console.WriteLine "Naggum test suite")
+
+(let ((thread (System.Threading.Thread.get_CurrentThread))
+      (culture (System.Globalization.CultureInfo.get_InvariantCulture)))
+    (System.Console.WriteLine "Setting up an environment...")
+    (call set_CurrentCulture thread culture))
+
+(test-let)

tests/let-funcall.result

@@ -0,0 +1,3 @@
+Naggum test suite
+Setting up an environment...
+Let: OK

tests/test.naggum

@@ -56,6 +56,11 @@
 
 (System.Console.WriteLine "Naggum test suite")
 
+(let ((thread (System.Threading.Thread.get_CurrentThread))
+      (culture (System.Globalization.CultureInfo.get_InvariantCulture)))
+    (System.Console.WriteLine "Setting up an environment...")
+    (call set_CurrentCulture thread culture))
+
 (test-funcall "OK")
 (test-conditionals)
 (test-let)

tests/test.result

@@ -1,4 +1,5 @@
 Naggum test suite
+Setting up an environment...
 Functions: OK
 Conditionals:
 Reduced if: OK