vhdl scanner: handle pragma translate_on/translate_off.

5 files changed, 109 insertions, 5 deletions

diff --git a/src/errorout.ads b/src/errorout.ads
index 39e170d6d..2c40d0047 100644
--- a/src/errorout.ads
+++ b/src/errorout.ads
@@ -53,6 +53,9 @@ package Errorout is
       --  Vhdl93 reserved word is used as a vhdl87 identifier.
       Warnid_Reserved_Word,
 
+      --  Anything about pragma: unknown pragma, nested pragma...
+      Warnid_Pragma,
+
       --  Start of block comment ('/*') appears in a block comment.
       Warnid_Nested_Comment,
 
@@ -277,6 +280,7 @@ private
    Default_Warnings : constant Warnings_Setting :=
      (Warnid_Library | Warnid_Binding | Warnid_Port | Warnid_Shared
         | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide
+        | Warnid_Pragma
         | Msgid_Warning  => (Enabled => True, Error => False),
       others             => (Enabled => False, Error => False));
 
diff --git a/src/std_names.adb b/src/std_names.adb
index 499eb29c4..91c9e5320 100644
--- a/src/std_names.adb
+++ b/src/std_names.adb
@@ -601,6 +601,9 @@ package body Std_Names is
       Def ("item",                  Name_Item);
       Def ("__FILE__",              Name_Uu_File_Uu);
       Def ("__LINE__",              Name_Uu_Line_Uu);
+      Def ("synthesis",             Name_Synthesis);
+      Def ("translate_off",         Name_Translate_Off);
+      Def ("translate_on",          Name_Translate_On);
       Def ("none",                  Name_None);
 
       Def ("ieee",               Name_Ieee);
diff --git a/src/std_names.ads b/src/std_names.ads
index 5b7cc7964..f4f3ec6a7 100644
--- a/src/std_names.ads
+++ b/src/std_names.ads
@@ -682,7 +682,10 @@ package Std_Names is
    Name_Item :                  constant Name_Id := Name_First_Misc + 033;
    Name_Uu_File_Uu :            constant Name_Id := Name_First_Misc + 034;
    Name_Uu_Line_Uu :            constant Name_Id := Name_First_Misc + 035;
-   Name_None :                  constant Name_Id := Name_First_Misc + 036;
+   Name_Synthesis :             constant Name_Id := Name_First_Misc + 036;
+   Name_Translate_Off :         constant Name_Id := Name_First_Misc + 037;
+   Name_Translate_On :          constant Name_Id := Name_First_Misc + 038;
+   Name_None :                  constant Name_Id := Name_First_Misc + 039;
    Name_Last_Misc :             constant Name_Id := Name_None;
 
    Name_First_Ieee         : constant Name_Id := Name_Last_Misc + 1;
diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb
index 8851b1c8e..8d51e58bb 100644
--- a/src/vhdl/vhdl-scanner.adb
+++ b/src/vhdl/vhdl-scanner.adb
@@ -152,6 +152,9 @@ package body Vhdl.Scanner is
       Token : Token_Type;
       Prev_Token : Token_Type;
 
+      --  Tokens are ignored because of 'translate_off'.
+      Translate_Off : Boolean;
+
       --  Additional values for the current token.
       Bit_Str_Base : Character;
       Bit_Str_Sign : Character;
@@ -175,6 +178,7 @@ package body Vhdl.Scanner is
                                      File_Len => 0,
                                      Token => Tok_Invalid,
                                      Prev_Token => Tok_Invalid,
+                                     Translate_Off => False,
                                      Identifier => Null_Identifier,
                                      Bit_Str_Base => ' ',
                                      Bit_Str_Sign => ' ',
@@ -350,6 +354,7 @@ package body Vhdl.Scanner is
                           File_Len => Get_File_Length (Source_File),
                           Token => Tok_Invalid,
                           Prev_Token => Tok_Invalid,
+                          Translate_Off => False,
                           Identifier => Null_Identifier,
                           Bit_Str_Base => ' ',
                           Bit_Str_Sign => ' ',
@@ -1594,7 +1599,7 @@ package body Vhdl.Scanner is
 
    --  Scan an identifier within a comment.  Only lower case letters are
    --  allowed.
-   procedure Scan_Comment_Identifier (Id : out Name_Id)
+   procedure Scan_Comment_Identifier (Id : out Name_Id; Create : Boolean)
    is
       use Name_Table;
       Buffer : String (1 .. Max_Name_Length);
@@ -1624,7 +1629,11 @@ package body Vhdl.Scanner is
          return;
       end if;
 
-      Id := Get_Identifier (Buffer (1 .. Len));
+      if Create then
+         Id := Get_Identifier (Buffer (1 .. Len));
+      else
+         Id := Get_Identifier_No_Create (Buffer (1 .. Len));
+      end if;
    end Scan_Comment_Identifier;
 
    package Directive_Protect is
@@ -1676,6 +1685,59 @@ package body Vhdl.Scanner is
       end if;
    end Scan_Tool_Directive;
 
+   --  Skip until new_line after translate_on/translate_off.
+   procedure Scan_Translate_On_Off (Id : Name_Id) is
+   begin
+      --  Expect new line.
+      Skip_Spaces;
+
+      if not Is_EOL (Source (Pos)) then
+         Warning_Msg_Scan (Warnid_Pragma, "garbage ignored after '%i'", +Id);
+         loop
+            Pos := Pos + 1;
+            exit when Is_EOL (Source (Pos));
+         end loop;
+      end if;
+   end Scan_Translate_On_Off;
+
+   procedure Scan_Translate_Off is
+   begin
+      --  'pragma translate_off' has just been scanned.
+      Scan_Translate_On_Off (Std_Names.Name_Translate_Off);
+
+      Current_Context.Translate_Off := True;
+
+      --  Recursive scan until 'translate_on' is scanned.
+      loop
+         Scan;
+         if not Current_Context.Translate_Off then
+            --  That token is discarded.
+            pragma Assert (Current_Token = Tok_Line_Comment);
+            Flag_Comment := False;
+            exit;
+         elsif Current_Token = Tok_Eof then
+            Warning_Msg_Scan (Warnid_Pragma,
+                              "unterminated 'translate_off'");
+            Current_Context.Translate_Off := False;
+            exit;
+         end if;
+      end loop;
+
+      --  The scanner is now at the EOL of the translate_on or at the EOF.
+      --  Continue scanning.
+   end Scan_Translate_Off;
+
+   procedure Scan_Translate_On is
+   begin
+      --  'pragma translate_off' has just been scanned.
+      Scan_Translate_On_Off (Std_Names.Name_Translate_On);
+
+      Current_Context.Translate_Off := False;
+
+      --  Return a token that will be discarded.
+      Flag_Comment := True;
+   end Scan_Translate_On;
+
    --  Scan tokens within a comment.  Return TRUE if Current_Token was set,
    --  return FALSE to discard the comment (ie treat it like a real comment).
    function Scan_Comment return Boolean
@@ -1683,7 +1745,7 @@ package body Vhdl.Scanner is
       use Std_Names;
       Id : Name_Id;
    begin
-      Scan_Comment_Identifier (Id);
+      Scan_Comment_Identifier (Id, False);
 
       if Id = Null_Identifier then
          return False;
@@ -1697,6 +1759,35 @@ package body Vhdl.Scanner is
                Flag_Scan_In_Comment := True;
                return True;
             end if;
+         when Name_Pragma
+           | Name_Synthesis =>
+            if Flag_Pragma_Comment then
+               Scan_Comment_Identifier (Id, True);
+               case Id is
+                  when Null_Identifier =>
+                     Warning_Msg_Scan
+                       (Warnid_Pragma, "incomplete pragma directive ignored");
+                  when Name_Translate_Off =>
+                     if Current_Context.Translate_Off then
+                        Warning_Msg_Scan
+                          (Warnid_Pragma, "nested 'translate_off' ignored");
+                     else
+                        Scan_Translate_Off;
+                     end if;
+                  when Name_Translate_On =>
+                     if Current_Context.Translate_Off then
+                        Scan_Translate_On;
+                     else
+                        Warning_Msg_Scan
+                          (Warnid_Pragma, "'translate_on' without "
+                             & "coresponding 'translate_off'");
+                     end if;
+                  when others =>
+                     Warning_Msg_Scan
+                       (Warnid_Pragma, "unknown pragma %i ignored", +Id);
+               end case;
+               return False;
+            end if;
          when others =>
             null;
       end case;
diff --git a/src/vhdl/vhdl-scanner.ads b/src/vhdl/vhdl-scanner.ads
index 1e18cc62f..461c431df 100644
--- a/src/vhdl/vhdl-scanner.ads
+++ b/src/vhdl/vhdl-scanner.ads
@@ -94,13 +94,16 @@ package Vhdl.Scanner is
    --  If true handle PSL embedded in comments: '--  psl' is ignored.
    Flag_Psl_Comment : Boolean := False;
 
+   --  If true, handle pragma translate_on/off.
+   Flag_Pragma_Comment : Boolean := False;
+
    --  If true, ignore '--'.  This is automatically set when Flag_Psl_Comment
    --  is true and a starting PSL keyword has been identified.
    --  Must be reset to false by the parser.
    Flag_Scan_In_Comment : Boolean := False;
 
    --  If true scan for keywords in comments.  Must be enabled if
-   --  Flag_Psl_Comment is true.
+   --  Flag_Psl_Comment or Flag_Pragma_Comment is true.
    Flag_Comment_Keyword : Boolean := False;
 
    --  If the next character is '!', eat it and return True, otherwise return