.travis.yml

 language: c
 sudo: required
+os: linux
 services:
   - docker
 
-## We build on as many OCaml version as we can support. These versions
-## are infact tags for the ocaml/opam2 Docker image that we pull.
-
-env:
-  - TAG=4.04
-  - TAG=4.05
-  - TAG=4.06 DEPLOY=true
-  - TAG=4.07
-  - TAG=alpine
-  - TAG=centos
-  - TAG=debian-stable
-  - TAG=debian-testing
-  - TAG=debian-unstable
-  - TAG=fedora
-  - TAG=opensuse
-  - TAG=oraclelinux
-  - TAG=ubuntu
-  - TAG=ubuntu-lts
-
 script:
   - docker build --build-arg tag=$TAG --build-arg switch=$SWITCH --tag colisanr/morbig:$TRAVIS_BRANCH .
   - docker run --entrypoint /bin/sh colisanr/morbig:$TRAVIS_BRANCH -c 'eval $(opam env) && cd /home/opam/morbig && make check && make install && make examples && make uninstall'
 
-## We add one particular build that does not use Docker. This is the
-## one testing on OSX.
-
 matrix:
   include:
     - os: osx
       services: null
-      env: null
       install:
         - brew install opam
         - opam init --no-setup
         - eval $(opam config env) && opam install --yes menhir yojson ppx_deriving_yojson visitors
       script:
         - make && make check && make install && make examples && make uninstall
+    - env: TAG=4.04
+    - env: TAG=4.05
+    - env: TAG=4.06 DEPLOY=true
+    - env: TAG=4.07
+    - env: TAG=4.08
+    - env: TAG=alpine
+    - env: TAG=centos
+    - env: TAG=debian-stable
+    - env: TAG=debian-testing
+    - env: TAG=debian-unstable
+    - env: TAG=opensuse
+    - env: TAG=ubuntu
+    - env: TAG=ubuntu-lts
 
 ## We automatically deploy sucessfull branch builds to DockerHub. This
 ## deployment only happens on builds that have the environment

Makefile

@@ -26,10 +26,10 @@ ifneq ($(LIBDIR),)
 INSTALL_ARGS := $(INSTALL_ARGS) --libdir $(LIBDIR)
 endif
 
-install:
+install: build
 	dune install $(INSTALL_ARGS)
 
-uninstall:
+uninstall: build
 	dune uninstall $(INSTALL_ARGS)
 
 check: build

README.md

 # Morbig
+
 ## A trustworthy static parser for POSIX shell
 
 Morbig is a parser for shell scripts written in the POSIX shell script
@@ -9,25 +10,28 @@ shell grammar of the POSIX standard.
 
 ## Download [![Build Status](https://travis-ci.org/colis-anr/morbig.svg?branch=master)](https://travis-ci.org/colis-anr/morbig)
 
-
-```
     git clone git@github.com:colis-anr/morbig.git
-```
 
 ## License and Copyright
 
-   please see the file COPYING
+Please see the file COPYING.
+
+## Documentation
+
+You can have a look at the
+[online API documentation](https://colis-anr.github.io/docs/) or build
+it yourself:
+
+    make doc
 
 ## Are you in a hurry?
 
 Yes? Pull our docker image:
-```
+
     docker pull colisanr/morbig:latest
-```
 
 Then, define the following shell function:
 
-```
     morbig () {
       D=$(cd "$(dirname "$1")"; pwd)
       B=$(basename "$1")
@@ -35,26 +39,32 @@ shell grammar of the POSIX standard.
         -v "$D":/mnt \
         colisanr/morbig:latest --as simple /mnt/"$B"
     }
-```
 
 After that, you should be able to run ``morbig`` like this:
 
-```
     morbig my-script.sh
-```
 
 This will create a JSON file named ``my-script.sh.sjson``.
 
-   You can also build a local docker image from the root of this repository:
+You can also build a local docker image from the root of this
+repository:
 
-```
     docker build -t morbig . # to build a docker image with morbig inside.
-```
 
-   Now if you want to use more features of ``morbig``, take the time
-   to follow the building instructions of the next section.
+Now if you want to use more features of ``morbig``, take the time to
+follow the building instructions of the next section.
+
+## Manual instructions
+
+### Install using OPAM
+
+Please type
+``
+opam install morbig
+``
+to get the latest public release of `morbig`.
 
-## Building instructions
+If you want to use the development version of `morbig`, read the next sections.
 
 ### Dependencies
 

debian/changelog

-morbig (0.10.3-3) UNRELEASED; urgency=medium
+morbig (0.10.4-1) unstable; urgency=medium
 
-  * Upload to unstable
+  * New upstream version
+  * Change build-dependency on dune to its new name ocaml-dune
+  * Drop build-dependency on ocamlbuild
   * Standards-Version 4.4.0 (no change)
 
- -- Ralf Treinen <treinen@debian.org>  Tue, 23 Jul 2019 20:22:09 -0300
+ -- Ralf Treinen <treinen@debian.org>  Fri, 08 Nov 2019 23:44:46 +0100
 
 morbig (0.10.3-2) experimental; urgency=medium
 

debian/control

@@ -5,8 +5,7 @@ Maintainer: Debian OCaml Maintainers <debian-ocaml-maint@lists.debian.org>
 Uploaders: Ralf Treinen <treinen@debian.org>,
 Build-Depends: debhelper-compat (= 12), dh-ocaml,
  ocaml-nox (>= 4.04),
- ocamlbuild,
- dune,
+ ocaml-dune,
  ocaml-findlib,
  menhir (>= 20170509),
  libmenhir-ocaml-dev (>= 20170509),

man/morbig.1

@@ -66,6 +66,9 @@ complete JSON output, including position information.
 .TP
 .I simple
 simplified JSON output. Use this for human-readable output.
+.TP
+.I none
+do not serialise the concrete syntax tree.
 .RE
 .TP
 .B \-\-from-stdin

morbig.opam

@@ -24,14 +24,13 @@ homepage: "https://github.com/colis-anr/morbig"
 bug-reports: "https://github.com/colis-anr/morbig/issues"
 dev-repo: "git://github.com/colis-anr/morbig.git"
 
-available: [os != "macos"]
 depends: [
   "dune"                 {build & >= "1.4.0"}
   "menhir"               {>= "20170509"}
-  "ocaml"                {build & >= "4.04"}
+  "ocaml"                {>= "4.04"}
   "odoc"                 {with-doc}
   "ppx_deriving_yojson"
-  "visitors"             {build & >= "20180513"}
+  "visitors"             {>= "20180513"}
   "yojson"
 ]
 

src/CST.ml

@@ -325,10 +325,11 @@ and word_component =
   | WordAssignmentWord of assignment_word
   | WordDoubleQuoted of word
   | WordSingleQuoted of word
+  | WordTildePrefix of string
   | WordLiteral of string
   | WordVariable of variable
-  | WordGlobAll
-  | WordGlobAny
+  | WordGlobAll   (* asterisk *)
+  | WordGlobAny   (* question mark *)
   | WordReBracketExpression of bracket_expression
   (* Empty CST. Useful to represent the absence of relevant CSTs. *)
   | WordEmpty

src/CSTHelpers.ml

@@ -91,7 +91,7 @@ let empty_linebreak' =
   with_pos dummy_position LineBreak_Empty
 
 let empty_program =
-  Program_LineBreak empty_linebreak'
+  with_pos dummy_position (Program_LineBreak empty_linebreak')
 
 let nonempty_program p =
   match p with
@@ -163,6 +163,22 @@ module NameSet = Set.Make (struct
   let compare (Name s1) (Name s2) = String.compare s1 s2
 end)
 
+let special_builtins_regexp =
+  [ "break" ; ":" ; "continue" ; "." ; "eval" ; "exec" ;
+    "exit" ; "export" ; "local" ; "readonly" ; "return" ;
+    "set" ; "shift" ; "times" ; "trap" ; "unset" ]
+
+let is_special_builtin s =
+  List.mem s special_builtins_regexp
+
+exception InvalidFunctionName
+
+let make_function_name (Name s) =
+  if is_special_builtin s then
+    raise InvalidFunctionName
+  else
+    Fname_Name (Name s)
+
 (* CST destructors *)
 
 (** [wordlist_of_cmd_suffix] extracts the list of all words from a cmd_sufix *)

src/CSTHelpers.mli

@@ -15,7 +15,7 @@ open CST
 
 (** {2 Helpers about programs and complete commands} *)
 
-val empty_program : program
+val empty_program : program located
 val nonempty_program : program -> bool
 val concat_programs : program located -> program located -> program located
 
@@ -35,6 +35,10 @@ val string_of_word : word -> string
 
 val word_placeholder : unit -> word' ref
 
+exception InvalidFunctionName
+
+val make_function_name: name -> fname
+
 module NameSet : Set.S
 
 (** {2 Helpers about positions} *)

src/REBracketExpressionParser.mly

@@ -191,10 +191,10 @@ meta_char: MINUS {
 }
 ;
 
+(* There is no specification for the language of [class_name] in POSIX. *)
 class_name: s=COLL_ELEM_SINGLE+
 {
   let b = Buffer.create 13 in
   List.iter (Buffer.add_char b) s;
-  let s = Buffer.contents b in
-  if Name.is_name s then s else raise Parsing.Parse_error
+  Buffer.contents b
 }

src/aliases.ml

@@ -14,6 +14,9 @@
 open Parser
 open Parser.MenhirInterpreter
 
+let perform default f =
+  if not (Options.disable_alias_expansion ()) then f () else default
+
 (**
 
    A shell script may define aliases with the following command:
@@ -120,6 +123,7 @@ let as_aliasing_related_command = function
     error is issued. Then, for any alias and unalias toplevel invocation,
     this function updates [aliases]. *)
 let interpret aliases cst =
+  perform empty @@ fun () ->
   let aliases = ref aliases in
   let level = ref 0 in
   let at_toplevel () = !level = 0 in
@@ -204,7 +208,9 @@ let inside_a_substitution_combo = function
 
 let quoted word =
   let len = String.length word in
-  len >= 2 && word.[0] = '\'' && word.[len - 1] = '\''
+  len >= 2
+  && ((word.[0] = '\'' && word.[len - 1] = '\'')
+      || (word.[0] = '"' && word.[len - 1] = '"'))
 
 let unquote word =
   String.(sub word 1 (length word - 2))
@@ -226,6 +232,7 @@ let only_if_end_with_whitespace word aliases state =
     alias by its definition if word is not a reserved word and
     if the parsing context is about to reduce a [cmd_name]. *)
 let alias_substitution aliases checkpoint word =
+  perform (aliases, word) @@ fun () ->
   if about_to_reduce_cmd_name checkpoint
      && not (Keyword.is_reserved_word word)
   then

src/dune

@@ -21,5 +21,7 @@
 (executable
  (name morbigDriver)
  (public_name morbig)
+ (ocamlopt_flags :standard)
  (libraries morbig)
+ (preprocess (pps ppx_deriving_yojson visitors.ppx)) ;; Avoid warning about incomplete merlin files.
  (modules morbigDriver))

src/engine.ml

@@ -45,7 +45,7 @@ let parse partial (module Lexer : Lexer) =
     (** Parsing loop. *)
     (**--------------**)
 
-  let rec parse { aliases; checkpoint } =
+  let rec parse csts { aliases; checkpoint } =
     match checkpoint with
       (**
 
@@ -58,7 +58,7 @@ let parse partial (module Lexer : Lexer) =
         let (token, ps, pe, aliases) =
           Lexer.next_token { aliases; checkpoint }
         in
-        parse { aliases; checkpoint = offer checkpoint (token, ps, pe) }
+        parse csts { aliases; checkpoint = offer checkpoint (token, ps, pe) }
 
       (**
 
@@ -75,13 +75,21 @@ let parse partial (module Lexer : Lexer) =
            assert false
         | Some true ->
            (** The EOF token was a real end-of-file marker. *)
-           cst
+           if Options.(backend () = NoSerialisation) then
+             []
+           else cst :: csts
         | Some false ->
            (** The EOF token was a pseudo end-of-file marker.
                Probably generated by a NEWLINE promoted to a EOF. *)
            Lexer.shift ();
            let checkpoint = entry_point (Lexer.current_position ()) in
-           CSTHelpers.concat_programs cst (parse { aliases; checkpoint })
+           let csts =
+             if Options.(backend () = NoSerialisation) then
+               []
+             else
+               cst :: csts
+           in
+           parse csts { aliases; checkpoint }
         end
 
       (**
@@ -113,7 +121,7 @@ let parse partial (module Lexer : Lexer) =
               (** 2.b Yes? Stop here.
                   Put back the token that caused the syntax error.
                   Return the CST  *)
-              cst
+              [cst]
            | _status ->
               (** 2.a No? It is a syntax error. *)
               parse_error ()
@@ -126,7 +134,7 @@ let parse partial (module Lexer : Lexer) =
 
       *)
       | HandlingError _env ->
-         parse { aliases; checkpoint = resume checkpoint }
+         parse csts { aliases; checkpoint = resume checkpoint }
 
       (**
 
@@ -184,11 +192,13 @@ let parse partial (module Lexer : Lexer) =
           if nt = AnyN N_complete_commands then
             on_top_symbol env { perform = interpret_alias_command }
           else
-            parse { aliases; checkpoint = resume checkpoint }
+            let checkpoint = resume checkpoint in
+            parse csts { aliases; checkpoint }
         and interpret_alias_command: type a. a symbol * a -> _ = function
           | N N_complete_command, cst ->
              let aliases = Aliases.interpret aliases cst in
-             parse { aliases; checkpoint = resume checkpoint }
+             let checkpoint = resume checkpoint in
+             parse csts { aliases; checkpoint }
           | _ ->
              assert false (* By correctness of the underlying LR automaton. *)
         in
@@ -201,16 +211,19 @@ let parse partial (module Lexer : Lexer) =
 
       *)
       | Shifting (_, _, _) ->
-        parse { aliases; checkpoint = resume checkpoint }
+        parse csts { aliases; checkpoint = resume checkpoint }
 
     and parse_error : type a. unit -> a = fun () ->
       raise (Errors.DuringParsing (Lexer.current_position ()))
   in
-  parse {
+  parse [] {
       aliases = Aliases.empty;
       checkpoint = entry_point (Lexer.current_position ())
     }
 
+let recognize_word_if_relevant checkpoint word =
+  accepted_token checkpoint word <> Wrong
+
 module Lexer (U : sig end) : Lexer = struct
 
   (**--------------------------**)
@@ -262,6 +275,9 @@ module Lexer (U : sig end) : Lexer = struct
 
   let tokens = ref []
 
+  let previous_token ?(n = 0) () =
+    ExtPervasives.list_nth_opt !tokens n
+
   let rec next_token { aliases; checkpoint } =
     if HDL.inside_here_document () then (
       !push_pretoken (HDL.next_here_document (lexbuf ()) (current ()));
@@ -279,7 +295,7 @@ module Lexer (U : sig end) : Lexer = struct
         | Pretoken.IoNumber i ->
           return (IO_NUMBER (IONumber i))
 
-        | Pretoken.PreWord (w, cst) ->
+        | Pretoken.PreWord (w0, cst) ->
 
         (*specification:
 
@@ -306,11 +322,26 @@ module Lexer (U : sig end) : Lexer = struct
            rules, or applies globally.
 
         *)
-          let new_aliases, w = alias_substitution aliases checkpoint w in
+          let new_aliases, w = alias_substitution aliases checkpoint w0 in
+          let word =
+            if w == w0 then
+              WORD (Word (w, List.(flatten (map parse_pattern cst))))
+            else
+              WORD (Word (w, [WordLiteral w]))
+          in
+          let well_delimited_keyword =
+            match previous_token () with
+              | Some (Semicolon | DSEMI | NEWLINE | Rbrace | Rparen | Uppersand
+                      | Fi) -> true
+              | _ -> match previous_token ~n:1 () with
+                     | Some For -> true
+                     | _ -> false
+          in
           let token = FirstSuccessMonad.(
             (recognize_assignment checkpoint p cst)
-            +> (recognize_reserved_word_if_relevant checkpoint p w)
-            +> return (WORD (Word (w, List.(flatten (map parse_pattern cst)))))
+            +> (recognize_reserved_word_if_relevant
+                  well_delimited_keyword checkpoint p w)
+            +> return word
           )
           in
           if HDL.next_word_is_here_document_delimiter () then
@@ -362,8 +393,12 @@ module Lexer (U : sig end) : Lexer = struct
           else if is_accepted_token checkpoint (NEWLINE, pstart, pstop) then
             return NEWLINE
 
+          else if is_accepted_token checkpoint (Semicolon, pstart, pstop) then
+            return Semicolon
+
         (** Otherwise, a [NEWLINE] is simply layout and is ignored. *)
-          else next_token { aliases; checkpoint }
+          else (* next_token { aliases; checkpoint }*)
+            raise (Errors.DuringParsing pstart)
 
   let last_state = ref None
 
@@ -377,7 +412,8 @@ module Lexer (U : sig end) : Lexer = struct
 
   let next_token ({ aliases; checkpoint } as state) =
     let curr_p = copy_position (lexbuf ()).Lexing.lex_curr_p in
-    let (raw, _, _, aliases) as token = next_token { aliases; checkpoint } in
+    let state' = { aliases; checkpoint } in
+    let (raw, _, _, aliases) as token = next_token state' in
     let state = { state with aliases } in
     tokens := raw :: !tokens;
     last_state := Some (state, token, curr_p);
@@ -417,6 +453,7 @@ end
 let parse partial current lexbuf =
   let module Lexer = Lexer (struct end) in
   Lexer.initialize current lexbuf;
-  parse partial (module Lexer)
+  let csts = List.rev (parse partial (module Lexer)) in
+  ExtPervasives.reduce CSTHelpers.empty_program CSTHelpers.concat_programs csts
 
 let close_knot = RecursiveParser.parse := (parse true)

src/extPervasives.ml

@@ -96,12 +96,13 @@ exception InvalidSuffix of string * string
 let string_split k s =
   let n = String.length s in
   let k = min k n in
-  String.sub s 0 k, String.sub s k (n - k)
+  try String.sub s 0 k, String.sub s k (n - k) with _ -> assert false
 
 let string_remove_suffix suffix s = String.(
   let k = length s - length suffix in
-  let r = sub s 0 k in
-  let c = sub s k (length suffix) in
+  if k < 0 then raise (InvalidSuffix (s, suffix));
+  let r = try sub s 0 k with _ -> assert false in
+  let c = try sub s k (length suffix) with _ -> assert false in
   if suffix <> c then raise (InvalidSuffix (s, suffix));
   r
 )
@@ -135,16 +136,31 @@ let string_of_char_list s =
   List.iter (Buffer.add_char b) s;
   Buffer.contents b
 
+let count_end_character c s =
+  let rec aux r i =
+    if i < 0 then r
+    else if s.[i] = c then aux (r + 1) (i - 1)
+    else r
+  in
+  aux 0 (String.length s - 1)
+
 (** [strip s] returns a copy of s, without any final newline *)
 let string_strip s =
   let n = String.length s in
   if n > 0
   then let lastchar = s.[n-1] in
-       if lastchar = '\n' || lastchar = '\r'
-       then String.sub s 0 (n-1)
+       if lastchar = '\n'
+       then try String.sub s 0 (n-1) with _ -> assert false
        else s
   else s
 
+let reduce default f l =
+  let rec aux accu = function
+    | [] -> accu
+    | x :: xs -> aux (f accu x) xs
+  in
+  if l = [] then default else aux (List.hd l) (List.tl l)
+
 let repeat n f =
   let rec aux i =
   if i = n then
@@ -179,6 +195,9 @@ let hashtbl_to_list h =
   Hashtbl.iter (fun k v -> l := (k, v) :: !l) h;
   !l
 
+let list_nth_opt l n =
+  try Some (List.nth l n) with _ -> None
+
 let list_hd_opt = function
   | [] -> None
   | x :: _ -> Some x
@@ -253,8 +272,11 @@ let ( <$> ) x f =
 let list_last l =
   list_hd_opt (List.rev l)
 
+let newline_regexp =
+  Str.regexp "\010"
+
 let lines s =
-  Str.(split (regexp "\n") s)
+  Str.split_delim newline_regexp s
 
 let string_last_line s =
   lines s |> list_last

src/hereDocument.ml

@@ -34,7 +34,7 @@ end = struct
 
    *)
 
-  type delim_info = {
+  type delimiter_info = {
         (** information about a delimiter of a here document: *)
       word: string;
         (** delimiting word, with quotes removed *)
@@ -45,7 +45,7 @@ end = struct
       contents_placeholder: CST.word CST.located ref
         (** placeholder for the contents of the here document *)
     }
-  let delimiters_queue = (Queue.create (): delim_info Queue.t)
+  let delimiters_queue = (Queue.create (): delimiter_info Queue.t)
   let dashed_tmp = ref (None: bool option)
   let word_ref_tmp = ref (None: word located ref option)
 
@@ -53,31 +53,39 @@ end = struct
     | NoHereDocuments
     (* we are currently not reading any here documents, nor have we seen
        a here document operator on the current line. *)
-    | HereDocumentsStartOnNextLine
-    (* we have seen a here document operator but we haven't yet finished
-       the line, so reading of here documents has to start on the next line. *)
+    | GotHereOperator
+    (* we have seen a here document operator but we haven't seen the 
+       corresponding delimite word yet.  *)
+    | GotDelimiter
+    (* we have seen a here document operator and its delimiter word. *)
     | InsideHereDocuments
     (* we are currently in the process of reading here documents. *)
   let state = ref NoHereDocuments
 
   let push_here_document_operator dashed word_ref =
-    assert (!state <> InsideHereDocuments);
+    if !state = GotHereOperator then
+      (* FIXME: we should raise an Error.DuringParsing here if we can
+         get the current lexing position. *)
+      failwith "redirection operator found where a delimter word is expected";
+    assert (!state = NoHereDocuments || !state = GotDelimiter);
     (* we accept a push of an operator only when the two variables
-       dashed_tmp and word_ref_tmp hold value None, that is either they
-       have never been assigned a value, or they have been assigned a value
-       which has been used up by push_here_document_delimiter.
+       dashed_tmp and word_ref_tmp hold value None, that is either
+       - they have not been assigned a value (state NoHereDocuments),
+       - or they have been assigned a value which has been used up by
+         push_here_document_delimiter (state GotDelimiter).
      *)
     assert (!dashed_tmp = None);
     dashed_tmp := Some dashed;
     assert (!word_ref_tmp = None);
     word_ref_tmp := Some word_ref;
-    state := HereDocumentsStartOnNextLine
+    state := GotHereOperator
 
   let push_here_document_delimiter _w cst =
     (* we accept a push of a delimiting word only if we have already received
        information about an operator which has not yet been used.
      *)
-    assert (!state <> InsideHereDocuments);
+    assert (!state = GotHereOperator);
+    let quoted_flag = ref false in
     let dashed = match !dashed_tmp with
       | Some b -> dashed_tmp:= None; b
       | None -> assert false
@@ -89,19 +97,26 @@ end = struct
       let rec unquote = function
         | [] -> ""
         | WordDoubleQuoted s :: w ->
+           quoted_flag := true;
            QuoteRemoval.on_string (unword s) ^ unquote w
         | WordSingleQuoted s :: w ->
+           quoted_flag := true;
            unword s ^ unquote w
         | (WordLiteral s | WordName s) :: w ->
-           let s = Str.(global_replace (regexp "\\") "" s) in
-           s ^ unquote w
+           let s' = Str.(global_replace (regexp "\\") "" s) in
+           if s <> s' then quoted_flag := true;
+           s' ^ unquote w
+        | WordVariable (VariableAtom (s, NoAttribute)) :: w ->
+           "$" ^ s ^ unquote w
         | _ ->
            failwith "Unsupported expansion in here document delimiter"
       in
       unquote cst
     in
     let quoted =
-      List.exists (function WordSingleQuoted _ -> true | _ -> false) cst
+      !quoted_flag
+      || List.exists (function WordSingleQuoted _ -> true | _ -> false) cst
+
     in
     Queue.add {
       (*specification:
@@ -113,7 +128,8 @@ end = struct
         quoted;
         dashed;
         contents_placeholder = word_ref
-      } delimiters_queue
+      } delimiters_queue;
+    state := GotDelimiter
 
   let next_here_document lexbuf current =
     (*specification:
@@ -123,7 +139,11 @@ end = struct
        between. Then the next here-document starts, if there is one.
      *)
     assert (!state = InsideHereDocuments);
-    let delimiter_info = Queue.take delimiters_queue in
+    let delimiter_info =
+      try
+        Queue.take delimiters_queue
+      with Queue.Empty -> failwith "here document problem"
+    in
 
     let store_here_document end_marker cst contents doc_start doc_end =
       (* store in the placeholder the here-document with contents [contents],
@@ -142,7 +162,7 @@ end = struct
           contents
       in
       let contents, cst =
-        remove_contents_suffix end_marker contents cst
+        remove_contents_suffix doc_end end_marker contents cst
       in
       let contents =
         (*specification:
@@ -160,21 +180,24 @@ end = struct
           position = { start_p = doc_start; end_p = doc_end }
         }
     in
-    let (Word (doc, cst)), doc_start, line_end =
+    let ((Word (doc, cst)), doc_start, line_end) =
       let current =
         enter_here_document delimiter_info.dashed delimiter_info.word current
       in
       let result =
         if delimiter_info.quoted then
-          let current = Prelexer.single_quotes current lexbuf in
+          let buffer = Buffer.create 13 in
+          let current = Prelexer.single_quotes buffer current lexbuf in
           return lexbuf current []
         else
           Prelexer.token current lexbuf
       in
       match result with
       | [Pretoken.NEWLINE, p1, p2] ->
-         (* Special case for empty here document. *)
+         (* Special case for empty here document or ended by EOF. *)
          (Word ("", []), p1, p2)
+      | [Pretoken.EOF, _, pos] ->
+         raise (Errors.DuringParsing pos)
       | result ->
          located_word_of result
     in
@@ -189,7 +212,7 @@ end = struct
     (Pretoken.NEWLINE, before_stop, line_end)
 
   let start_here_document_lexing () =
-    assert (!state = HereDocumentsStartOnNextLine);
+    assert (!state = GotDelimiter);
     state := InsideHereDocuments
 
   let next_word_is_here_document_delimiter () =
@@ -200,7 +223,7 @@ end = struct
     !dashed_tmp <> None
 
   let next_line_is_here_document () =
-    !state = HereDocumentsStartOnNextLine
+    !state = GotDelimiter
 
   let inside_here_document () =
     !state = InsideHereDocuments

src/hereDocument.mli

@@ -24,7 +24,7 @@ module Lexer :
         bool -> CST.word CST.located ref -> unit
       (** [push_here_document_operator dashed word_ref] registers a redirection
           operator:
-          - [dashed] is [true] when the operator is <<-, and [false] if <<-
+          - [dashed] is [true] when the operator is <<-, and [false] if <<
           - [word_ref] is a reference to a located word. This reference will
              later be assigned the contents of the here document.
        *)

src/keyword.ml

@@ -73,11 +73,20 @@ let terminal_of_keyword k =
   let (_, _, t) = List.find (fun (_, k', _) -> k = k') keywords in
   t
 
-let recognize_reserved_word_if_relevant checkpoint (_pretoken, pstart, pstop) w =
+let must_be_well_delimited flag = function
+  | Rbrace | Do | Done | Then | Else | Elif | Fi | Esac -> flag
+  | _ -> true
+
+let recognize_reserved_word_if_relevant well_delimited checkpoint p w =
+  let (_, pstart, pstop) = p in
+  let valid_token kwd =
+    accepted_token checkpoint (kwd, pstart, pstop) <> Wrong
+    && must_be_well_delimited well_delimited kwd
+  in
   FirstSuccessMonad.(
     let as_keyword =
       keyword_of_string w >>= fun kwd ->
-      return_if (accepted_token checkpoint (kwd, pstart, pstop) <> Wrong) kwd
+      return_if (valid_token kwd) kwd
     in
     let as_name =
       return_if (Name.is_name w) (NAME (CST.Name w))

src/morbigDriver.ml

@@ -15,12 +15,17 @@ open Morbig
 
 let save input_filename (cst : CST.program) =
   Options.(
+    if backend () = NoSerialisation
+    then
+      ()
+    else
       let cout = open_out (output_file_of_input_file input_filename) in
       begin match backend () with
       | Bin -> save_binary_cst cout cst
       | Json -> save_json_cst cout cst
       | SimpleJson -> JsonHelpers.save_as_json true cout cst
       | Dot -> JsonHelpers.save_as_dot cout cst
+      | NoSerialisation -> assert false
       end;
       close_out cout
   )

src/name.ml

@@ -27,7 +27,17 @@
     This definition implies that a name is not empty.
 
 *)
+let alpha c =
+  ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || (c = '_')
+
+let alphanum c =
+  alpha c || ('0' <= c && c <= '9')
+
 let is_name s =
-  s <> ""
-  && Str.(string_match (
-              regexp "^\\([a-zA-Z]\\|_\\)\\([a-zA-Z]\\|_\\|[0-9]\\)*$") s 0)
+  let len = String.length s in
+  let rec aux i =
+    i = len || (alphanum s.[i] && aux (i + 1))
+  in
+  if len = 0 then false
+  else if not (alpha s.[0]) then false
+  else aux 0