From 2681711a47f7ada17aae9da74ecfc5af53262b6b Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 31 Oct 2014 05:22:09 +0100 Subject: Handle delimited comments. --- errorout.adb | 8 +++++ errorout.ads | 1 + scanner.adb | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++++------- 3 files changed, 111 insertions(+), 13 deletions(-) diff --git a/errorout.adb b/errorout.adb index af6977d31..1652bb43e 100644 --- a/errorout.adb +++ b/errorout.adb @@ -239,6 +239,14 @@ package body Errorout is Put_Line (Msg); end Error_Msg_Scan; + procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is + begin + Nbr_Errors := Nbr_Errors + 1; + Disp_Location (Loc); + Put (' '); + Put_Line (Msg); + end Error_Msg_Scan; + -- Disp a message during scan. procedure Warning_Msg_Scan (Msg: String) is begin diff --git a/errorout.ads b/errorout.ads index 35a653115..ce694fe37 100644 --- a/errorout.ads +++ b/errorout.ads @@ -58,6 +58,7 @@ package Errorout is -- Disp a message during scan. -- The current location is automatically displayed before the message. procedure Error_Msg_Scan (Msg: String); + procedure Error_Msg_Scan (Msg: String; Loc : Location_Type); procedure Warning_Msg_Scan (Msg: String); -- Disp a message during parse diff --git a/scanner.adb b/scanner.adb index 707519c53..260bd7c8f 100644 --- a/scanner.adb +++ b/scanner.adb @@ -1016,6 +1016,41 @@ package body Scanner is end if; end Scan_Underscore; + -- The Scan_Next_Line procedure must be called after each end-of-line to + -- register to next line number. This is called by Scan_CR_Newline and + -- Scan_LF_Newline. + procedure Scan_Next_Line is + begin + Current_Context.Line_Number := Current_Context.Line_Number + 1; + Current_Context.Line_Pos := Pos; + File_Add_Line_Number + (Current_Context.Source_File, Current_Context.Line_Number, Pos); + end Scan_Next_Line; + + -- Scan a CR end-of-line. + procedure Scan_CR_Newline is + begin + -- Accept CR or CR+LF as line separator. + if Source (Pos + 1) = LF then + Pos := Pos + 2; + else + Pos := Pos + 1; + end if; + Scan_Next_Line; + end Scan_CR_Newline; + + -- Scan a LF end-of-line. + procedure Scan_LF_Newline is + begin + -- Accept LF or LF+CR as line separator. + if Source (Pos + 1) = CR then + Pos := Pos + 2; + else + Pos := Pos + 1; + end if; + Scan_Next_Line; + end Scan_LF_Newline; + -- Get a new token. procedure Scan is begin @@ -1025,7 +1060,7 @@ package body Scanner is << Again >> null; - -- Skip commonly used separators. + -- Skip commonly used separators. while Source(Pos) = ' ' or Source(Pos) = HT loop Pos := Pos + 1; end loop; @@ -1046,19 +1081,15 @@ package body Scanner is when VT | FF => Pos := Pos + 1; goto Again; - when LF | CR => - -- Accept CR, LF, CR+LF or LF+CR as line separator. - if (Source (Pos) = LF and then Source (Pos + 1) = CR) - or else (Source (Pos) = CR and then Source (Pos + 1) = LF) - then - Pos := Pos + 2; - else - Pos := Pos + 1; + when LF => + Scan_LF_Newline; + if Flag_Newline then + Current_Token := Tok_Newline; + return; end if; - Current_Context.Line_Number := Current_Context.Line_Number + 1; - Current_Context.Line_Pos := Pos; - File_Add_Line_Number - (Current_Context.Source_File, Current_Context.Line_Number, Pos); + goto Again; + when CR => + Scan_CR_Newline; if Flag_Newline then Current_Token := Tok_Newline; return; @@ -1139,6 +1170,64 @@ package body Scanner is if Source (Pos + 1) = '=' then Current_Token := Tok_Not_Equal; Pos := Pos + 2; + elsif Source (Pos + 1) = '*' then + -- LRM08 15.9 Comments + -- A delimited comment start with a solidus (slash) character + -- immediately followed by an asterisk character and extends up + -- to the first subsequent occurrence of an asterisk character + -- immediately followed by a solidus character. + if Vhdl_Std < Vhdl_08 then + Error_Msg_Scan + ("block comment are not allowed before vhdl 2008"); + end if; + + -- Skip '/*'. + Pos := Pos + 2; + + loop + case Source (Pos) is + when '/' => + -- LRM08 15.9 + -- Moreover, an occurrence of a solidus character + -- immediately followed by an asterisk character + -- within a delimited comment is not interpreted as + -- the start of a nested delimited comment. + if Source (Pos + 1) = '*' then + Warning_Msg_Scan + ("'/*' found within a block comment"); + end if; + Pos := Pos + 1; + when '*' => + if Source (Pos + 1) = '/' then + Pos := Pos + 2; + exit; + else + Pos := Pos + 1; + end if; + when CR => + Scan_CR_Newline; + when LF => + Scan_LF_Newline; + when Files_Map.EOT => + if Pos >= Current_Context.File_Len then + -- Point at the start of the comment. + Error_Msg_Scan + ("block comment not terminated at end of file", + File_Pos_To_Location + (Current_Context.Source_File, + Current_Context.Token_Pos)); + exit; + end if; + Pos := Pos + 1; + when others => + Pos := Pos + 1; + end case; + end loop; + if Flag_Comment then + Current_Token := Tok_Comment; + return; + end if; + goto Again; else Current_Token := Tok_Slash; Pos := Pos + 1; -- cgit v1.2.3