1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Sebastien Hinderer, projet Gallium, INRIA Paris *)
6 (* *)
7 (* Copyright 2016 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Lexer definitions for the Tests Specification Language and for
17 response files *)
18
19 {
20 open Tsl_parser
21
22 let comment_start_pos = ref []
23
24 let lexer_error message =
25 failwith (Printf.sprintf "Tsl lexer: %s" message)
26 }
27
28 let newline = ('\013'* '\010')
29 let blank = [' ' '\009' '\012']
30 let identchar = ['A'-'Z' 'a'-'z' '_' '.' '-' '\'' '0'-'9']
31
32 rule token = parse
33 | blank * { token lexbuf }
34 | newline { Lexing.new_line lexbuf; token lexbuf }
35 | "/*" blank* "TEST" { TSL_BEGIN_C_STYLE }
36 | "*/" { TSL_END_C_STYLE }
37 | "(*" blank* "TEST" { TSL_BEGIN_OCAML_STYLE }
38 | "*)" { TSL_END_OCAML_STYLE }
39 | "," { COMA }
40 | '*'+ { TEST_DEPTH (String.length (Lexing.lexeme lexbuf)) }
41 | "+=" { PLUSEQUAL }
42 | "=" { EQUAL }
43 | identchar *
44 { let s = Lexing.lexeme lexbuf in
45 match s with
46 | "include" -> INCLUDE
47 | "set" -> SET
48 | "with" -> WITH
49 | _ -> IDENTIFIER s
50 }
51 | "(*"
52 {
53 comment_start_pos := [Lexing.lexeme_start_p lexbuf];
54 comment lexbuf
55 }
56 | '"'
57 { STRING (string "" lexbuf) }
58 | _
59 {
60 let pos = Lexing.lexeme_start_p lexbuf in
61 let file = pos.Lexing.pos_fname in
62 let line = pos.Lexing.pos_lnum in
63 let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
64 let message = Printf.sprintf "%s:%d:%d: unexpected character %s"
65 file line column (Lexing.lexeme lexbuf) in
66 lexer_error message
67 }
68 | eof
69 { lexer_error "unexpected eof" }
70 (* Backslashes are ignored in strings except at the end of lines where they
71 cause the newline to be ignored. After an escaped newline, any blank
72 characters at the start of the line are ignored and optionally one blank
73 character may be escaped with a backslash.
74
75 In particular, this means that the following:
76 script = "some-directory\\
77 \ foo"
78 is interpreted as the OCaml string "some-directory\\ foo".
79 *)
80 and string acc = parse
81 | [^ '\\' '"' ]+
82 { string (acc ^ Lexing.lexeme lexbuf) lexbuf }
83 | '\\' newline blank* ('\\' (blank as blank))?
84 { let space =
85 match blank with None -> "" | Some blank -> String.make 1 blank
86 in
87 string (acc ^ space) lexbuf }
88 | '\\'
89 {string (acc ^ "\\") lexbuf}
90 | '"'
91 {acc}
92 and comment = parse
93 | "(*"
94 {
95 comment_start_pos :=
96 (Lexing.lexeme_start_p lexbuf) :: !comment_start_pos;
97 comment lexbuf
98 }
99 | "*)"
100 {
101 comment_start_pos := List.tl !comment_start_pos;
102 if !comment_start_pos = [] then token lexbuf else comment lexbuf
103 }
104 | eof
105 {
106 let pos = List.hd !comment_start_pos in
107 let file = pos.Lexing.pos_fname in
108 let line = pos.Lexing.pos_lnum in
109 let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
110 let message = Printf.sprintf "%s:%d:%d: unterminated comment"
111 file line column in
112 lexer_error message
113 }
114 | _
115 {
116 comment lexbuf
117 }
118
119 (* Parse one line of a response file (for scripts and hooks) *)
120 and modifier = parse
121 | '-' (identchar* as variable)
122 { variable, `Remove }
123 | (identchar* as variable) "=\"" (_* as str) '"'
124 { variable, `Add str }
125 | (identchar* as variable) "+=\"" (_* as str) '"'
126 { variable, `Append str }
127 | _
128 { failwith "syntax error in script response file" }
129