diff --git a/cparser/Diagnostics.ml b/cparser/Diagnostics.ml index 8a8a0c178..73648a2a8 100644 --- a/cparser/Diagnostics.ml +++ b/cparser/Diagnostics.ml @@ -105,6 +105,7 @@ type warning_type = | Reduced_alignment | Non_linear_cond_expr | Invalid_UTF8 + | Dollar_in_identifier (* List of all warnings with default status. "true" means the warning is active by default. @@ -142,6 +143,7 @@ let all_warnings = (Reduced_alignment, false); (Non_linear_cond_expr, false); (Invalid_UTF8, true); + (Dollar_in_identifier, false) ] (* List of active warnings *) @@ -185,6 +187,7 @@ let string_of_warning = function | Reduced_alignment -> "reduced-alignment" | Non_linear_cond_expr -> "non-linear-cond-expr" | Invalid_UTF8 -> "invalid-utf8" + | Dollar_in_identifier -> "dollar-in-identifier-extension" (* Activate the given warning *) let activate_warning w () = diff --git a/cparser/Diagnostics.mli b/cparser/Diagnostics.mli index e7d6fa0ff..78b62be0d 100644 --- a/cparser/Diagnostics.mli +++ b/cparser/Diagnostics.mli @@ -58,6 +58,7 @@ type warning_type = | Reduced_alignment (** alignment reduction *) | Non_linear_cond_expr (** condition that cannot be linearized *) | Invalid_UTF8 (** invalid UTF-8 encoding *) + | Dollar_in_identifier (** '$' sign in identifier *) val warning : (string * int) -> warning_type -> ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a (** [warning (f,c) w fmt arg1 ... argN] formats the arguments [arg1] to [argN] as warining according to diff --git a/cparser/Lexer.mll b/cparser/Lexer.mll index 5d377053d..31965cee5 100644 --- a/cparser/Lexer.mll +++ b/cparser/Lexer.mll @@ -150,6 +150,21 @@ let warning lb kind fmt = Diagnostics.warning (lb.lex_curr_p.pos_fname,lb.lex_curr_p.pos_lnum) kind fmt +(* Identifiers or keywords *) + +let ident_or_keyword lb id = + try + let f = Hashtbl.find lexicon id in + f (currentLoc lb) + with Not_found -> + if String.contains id '$' then begin + if id = "$" then + error lb "not supported: identifier consisting of a single '$' sign" + else + warning lb Diagnostics.Dollar_in_identifier "'$' in identifier"; + end; + PRE_NAME id + (* Simple character escapes *) let convert_escape = function @@ -416,12 +431,9 @@ rule initial = parse | ";" { SEMICOLON(currentLoc lexbuf) } | "," { COMMA(currentLoc lexbuf) } | "." { DOT(currentLoc lexbuf) } - | identifier as id { - if SSet.mem id !ignored_keywords then - initial lexbuf - else - try Hashtbl.find lexicon id (currentLoc lexbuf) - with Not_found -> PRE_NAME id } + | identifier as id { if SSet.mem id !ignored_keywords + then initial lexbuf + else ident_or_keyword lexbuf id } | eof { EOF } | _ as c { fatal_error lexbuf "invalid symbol %C" c }