diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2002-11-24 00:07:31 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2002-11-24 00:07:31 +0000 |
commit | 9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4 (patch) | |
tree | 683175dc3f892806f31ff2120b1b5ed818c038ef /perl_checker.src/lexer.mll | |
parent | 311a8f18e0dbdddf23f0c52c3a6da76926e556fb (diff) | |
download | perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.gz perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.bz2 perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.tar.xz perl-MDK-Common-9d2129c561e82d14c6e5ae82cd2f3ae5a34d12a4.zip |
*** empty log message ***
Diffstat (limited to 'perl_checker.src/lexer.mll')
-rw-r--r-- | perl_checker.src/lexer.mll | 45 |
1 files changed, 32 insertions, 13 deletions
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll index 3ebce72..e54e968 100644 --- a/perl_checker.src/lexer.mll +++ b/perl_checker.src/lexer.mll @@ -18,7 +18,7 @@ type raw_token = | BAREWORD of (string * raw_pos) | BAREWORD_PAREN of (string * raw_pos) | REVISION of (string * raw_pos) - | COMMENT of (string * raw_pos) + | PERL_CHECKER_COMMENT of (string * raw_pos) | POD of (string * raw_pos) | LABEL of (string * raw_pos) | COMMAND_STRING of (raw_interpolated_string * raw_pos) @@ -38,7 +38,7 @@ type raw_token = | ARRAYLEN_IDENT of (string option * string * raw_pos) | FUNC_DECL_WITH_PROTO of (string * string * raw_pos) - | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY of raw_pos | CONTINUE of raw_pos | SUB of raw_pos + | IF of raw_pos | ELSIF of raw_pos | ELSE of raw_pos | UNLESS of raw_pos | DO of raw_pos | WHILE of raw_pos | UNTIL of raw_pos | MY_OUR of (string * raw_pos) | CONTINUE of raw_pos | SUB of raw_pos | LOCAL of raw_pos | FOR of (string * raw_pos) | USE of raw_pos | PACKAGE of raw_pos | BEGIN of raw_pos | END of raw_pos | PRINT of (string * raw_pos) | NEW of (raw_pos) | FORMAT of (raw_pos) | AT of raw_pos | DOLLAR of raw_pos | PERCENT of raw_pos | AMPERSAND of raw_pos | STAR of raw_pos | ARRAYLEN of raw_pos | SEMI_COLON of raw_pos | PKG_SCOPE of raw_pos | PAREN of raw_pos | PAREN_END of raw_pos | BRACKET of raw_pos @@ -72,7 +72,7 @@ let rec raw_token_to_pos_and_token spaces = function | BAREWORD(s, pos) -> pos, Parser.BAREWORD(s, (spaces, pos)) | BAREWORD_PAREN(s, pos) -> pos, Parser.BAREWORD_PAREN(s, (spaces, pos)) | REVISION(s, pos) -> pos, Parser.REVISION(s, (spaces, pos)) - | COMMENT(s, pos) -> pos, Parser.COMMENT(s, (spaces, pos)) + | PERL_CHECKER_COMMENT(s, pos) -> pos, Parser.PERL_CHECKER_COMMENT(s, (spaces, pos)) | POD(s, pos) -> pos, Parser.POD(s, (spaces, pos)) | LABEL(s, pos) -> pos, Parser.LABEL(s, (spaces, pos)) | PRINT(s, pos) -> pos, Parser.PRINT(s, (spaces, pos)) @@ -102,6 +102,7 @@ let rec raw_token_to_pos_and_token spaces = function | BIT_SHIFT(s, pos) -> pos, Parser.BIT_SHIFT(s, (spaces, pos)) | PLUS(s, pos) -> pos, Parser.PLUS(s, (spaces, pos)) | ONE_SCALAR_PARA(s, pos) -> pos, Parser.ONE_SCALAR_PARA(s, (spaces, pos)) + | MY_OUR(s, pos) -> pos, Parser.MY_OUR(s, (spaces, pos)) | EOF (pos) -> pos, Parser.EOF ((), (spaces, pos)) | IF (pos) -> pos, Parser.IF ((), (spaces, pos)) @@ -111,7 +112,6 @@ let rec raw_token_to_pos_and_token spaces = function | DO (pos) -> pos, Parser.DO ((), (spaces, pos)) | WHILE (pos) -> pos, Parser.WHILE ((), (spaces, pos)) | UNTIL (pos) -> pos, Parser.UNTIL ((), (spaces, pos)) - | MY (pos) -> pos, Parser.MY ((), (spaces, pos)) | CONTINUE (pos) -> pos, Parser.CONTINUE ((), (spaces, pos)) | SUB (pos) -> pos, Parser.SUB ((), (spaces, pos)) | LOCAL (pos) -> pos, Parser.LOCAL ((), (spaces, pos)) @@ -281,6 +281,10 @@ let ident_type_from_char fq name lexbuf c = | '*' -> STAR_IDENT (fq, name, pos lexbuf) | _ -> internal_error "ident_type_from_char" +let split_at_two_colons s = + let i_fq = String.rindex s ':' in + String.sub s 0 (i_fq - 1), skip_n_char (i_fq + 1) s + let ident_from_lexbuf lexbuf = let fq, name = split_at_two_colons (lexeme lexbuf) in RAW_IDENT(Some fq, name, pos lexbuf) @@ -325,6 +329,7 @@ rule token = parse if lexeme_start lexbuf = !not_ok_for_match then not_ok_for_match := lexeme_end lexbuf; SPACE(lexeme_end lexbuf - lexeme_start lexbuf) } +| "# perl_checker: " [^ '\n']* { PERL_CHECKER_COMMENT(skip_n_char 16 (lexeme lexbuf), pos lexbuf) } | '#' [^ '\n']* { SPACE(1) } | "\n=" { @@ -395,7 +400,8 @@ rule token = parse | "until" { UNTIL(pos lexbuf) } | "foreach" { FOR(lexeme lexbuf, pos lexbuf) } | "for" { FOR(lexeme lexbuf, pos lexbuf) } -| "my" { MY(pos lexbuf) } +| "my" { MY_OUR(lexeme lexbuf, pos lexbuf) } +| "our" { MY_OUR(lexeme lexbuf, pos lexbuf) } | "local" { LOCAL(pos lexbuf) } | "continue" { CONTINUE(pos lexbuf) } | "sub" { SUB(pos lexbuf) } @@ -413,11 +419,11 @@ rule token = parse | "print " ident ' ' { putback lexbuf 1; - PRINT_TO_STAR(skip_n_char_ 6 1 (lexeme lexbuf), pos lexbuf); + PRINT_TO_STAR(skip_n_char 6 (lexeme lexbuf), pos lexbuf); } | "print $" ident ' ' { putback lexbuf 1; - PRINT_TO_SCALAR(skip_n_char_ 7 1 (lexeme lexbuf), pos lexbuf); + PRINT_TO_SCALAR(skip_n_char 7 (lexeme lexbuf), pos lexbuf); } | ident ' '* "=>" { (* needed so that (if => 1) works *) @@ -556,7 +562,7 @@ rule token = parse | '$' [^ '{' ' ' '\n' '$'] | "$^" [^ '{' ' ' '\n'] { typed_ident_from_lexbuf lexbuf } -| "$$" [^ 'a'-'z' 'A'-'Z' '_' '{'] { putback lexbuf 1; SCALAR_IDENT(None, "$$", pos lexbuf) } +| "$$" [^ 'a'-'z' 'A'-'Z' '_' '{'] { putback lexbuf 1; SCALAR_IDENT(None, "$", pos lexbuf) } | stash "::" { putback lexbuf 2; ident_type_from_char None "main" lexbuf (lexeme_char lexbuf 0) } @@ -612,7 +618,7 @@ and string = parse and delimited_string = parse | '\\' { Stack.push delimited_string next_rule ; string_escape lexbuf } | '$' { Stack.push delimited_string next_rule ; delimited_string_interpolate_scalar lexbuf } -| '@' { Stack.push delimited_string next_rule ; string_interpolate_array lexbuf } +| '@' { Stack.push delimited_string next_rule ; delimited_string_interpolate_array lexbuf } | '\n' { add_a_new_line(lexeme_end lexbuf); next delimited_string lexbuf @@ -738,15 +744,14 @@ and delimited_string_interpolate_scalar = parse (* needed for delimited string l die lexbuf (Printf.sprintf "I really can't handle this, [xxx] can be indexing or not based on stellar position :-(") } - | "{" | ident "->"? '{' | eof { next_s "$" (Stack.pop next_rule) lexbuf } | _ { let c = lexeme_char lexbuf 0 in - if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); + if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); putback lexbuf 1; - (Stack.pop next_rule) lexbuf + next_s "$" (Stack.pop next_rule) lexbuf } and string_interpolate_array = parse @@ -754,10 +759,24 @@ and string_interpolate_array = parse | '{' [^ '{' '}']* '}' | (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf } -| [ '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } | eof { next_s "$" (Stack.pop next_rule) lexbuf } | _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +and delimited_string_interpolate_array = parse +| '$' ident +| '{' [^ '{' '}']* '}' +| (ident | (ident? ("::" ident)+)) { string_interpolate token "@" lexbuf } + +| [ '@' '*' '<' '>' ']' '.' '('] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf } +| eof { next_s "$" (Stack.pop next_rule) lexbuf } +| _ { + let c = lexeme_char lexbuf 0 in + if c <> !delimit_char then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); + putback lexbuf 1; + next_s "$" (Stack.pop next_rule) lexbuf + } + and pattern_options = parse | [ 'g' 'i' 'm' 'o' 's' 'x' 'e' 'd' ] { next pattern_options lexbuf } | _ { putback lexbuf 1; () } |