vhdl psl: fully scan PSL keywords in scanner.

6 files changed, 141 insertions, 66 deletions

diff --git a/src/vhdl/vhdl-parse_psl.adb b/src/vhdl/vhdl-parse_psl.adb
index b4957b1ab..956414e0f 100644
--- a/src/vhdl/vhdl-parse_psl.adb
+++ b/src/vhdl/vhdl-parse_psl.adb
@@ -485,24 +485,27 @@ package body Vhdl.Parse_Psl is
       end if;
    end Parse_Parenthesis_FL_Property;
 
-   --  Parse [ '!' ] '[' finite_Range ']' '(' FL_Property ')'
-   function Parse_Range_Property (K : Nkind) return Node is
+   --  Parse '[' finite_Range ']' '(' FL_Property ')'
+   function Parse_Range_Property (K : Nkind; Strong : Boolean) return Node
+   is
       Res : Node;
    begin
       Res := Create_Node_Loc (K);
-      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Set_Strong_Flag (Res, Strong);
       Scan;
       Parse_Bracket_Range (Res);
       Set_Property (Res, Parse_Parenthesis_FL_Property);
       return Res;
    end Parse_Range_Property;
 
-   --  Parse [ '!' ] '(' Boolean ')' '[' Range ']' '(' FL_Property ')'
-   function Parse_Boolean_Range_Property (K : Nkind) return Node is
+   --  Parse '(' Boolean ')' '[' Range ']' '(' FL_Property ')'
+   function Parse_Boolean_Range_Property (K : Nkind; Strong : Boolean)
+                                         return Node
+   is
       Res : Node;
    begin
       Res := Create_Node_Loc (K);
-      Set_Strong_Flag (Res, Scan_Exclam_Mark);
+      Set_Strong_Flag (Res, Strong);
       Scan;
       Set_Boolean (Res, Parse_Parenthesis_Boolean);
       Parse_Bracket_Range (Res);
@@ -524,11 +527,8 @@ package body Vhdl.Parse_Psl is
             Res := Create_Node_Loc (N_Never);
             Scan;
             Set_Property (Res, Parse_FL_Property (Prio_FL_Invariance));
-         when Tok_Eventually =>
+         when Tok_Eventually_Em =>
             Res := Create_Node_Loc (N_Eventually);
-            if not Scan_Exclam_Mark then
-               Error_Msg_Parse ("'eventually' must be followed by '!'");
-            end if;
             Scan;
             Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
          when Tok_Next =>
@@ -541,9 +541,13 @@ package body Vhdl.Parse_Psl is
                Set_Property (Res, Parse_FL_Property (Prio_FL_Occurence));
             end if;
          when Tok_Next_A =>
-            Res := Parse_Range_Property (N_Next_A);
+            Res := Parse_Range_Property (N_Next_A, False);
+         when Tok_Next_A_Em =>
+            Res := Parse_Range_Property (N_Next_A, True);
          when Tok_Next_E =>
-            Res := Parse_Range_Property (N_Next_E);
+            Res := Parse_Range_Property (N_Next_E, False);
+         when Tok_Next_E_Em =>
+            Res := Parse_Range_Property (N_Next_E, True);
          when Tok_Next_Event =>
             Res := Create_Node_Loc (N_Next_Event);
             Scan;
@@ -553,9 +557,13 @@ package body Vhdl.Parse_Psl is
             end if;
             Set_Property (Res, Parse_Parenthesis_FL_Property);
          when Tok_Next_Event_A =>
-            Res := Parse_Boolean_Range_Property (N_Next_Event_A);
+            Res := Parse_Boolean_Range_Property (N_Next_Event_A, False);
+         when Tok_Next_Event_A_Em =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_A, True);
          when Tok_Next_Event_E =>
-            Res := Parse_Boolean_Range_Property (N_Next_Event_E);
+            Res := Parse_Boolean_Range_Property (N_Next_Event_E, False);
+         when Tok_Next_Event_E_Em =>
+            Res := Parse_Boolean_Range_Property (N_Next_Event_E, True);
          when Tok_Left_Paren =>
             return Parse_Parenthesis_FL_Property;
          when Tok_Left_Curly =>
@@ -576,12 +584,15 @@ package body Vhdl.Parse_Psl is
       return Res;
    end Parse_FL_Property_1;
 
-   function Parse_St_Binary_FL_Property (K : Nkind; Left : Node) return Node is
+   function Parse_St_Binary_FL_Property
+     (K : Nkind; Left : Node; Strong : Boolean; Inclusive : Boolean)
+     return Node
+   is
       Res : Node;
    begin
       Res := Create_Node_Loc (K);
-      Set_Strong_Flag (Res, Scan_Exclam_Mark);
-      Set_Inclusive_Flag (Res, Scan_Underscore);
+      Set_Strong_Flag (Res, Strong);
+      Set_Inclusive_Flag (Res, Inclusive);
       Scan;
       Set_Left (Res, Left);
       Set_Right (Res, Parse_FL_Property (Prio_FL_Bounding));
@@ -746,12 +757,43 @@ package body Vhdl.Parse_Psl is
                if Prio > Prio_FL_Bounding then
                   return Res;
                end if;
-               Res := Parse_St_Binary_FL_Property (N_Until, Res);
+               Res := Parse_St_Binary_FL_Property (N_Until, Res, False, False);
+            when Tok_Until_Em =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Until, Res, True, False);
+            when Tok_Until_Un =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Until, Res, False, True);
+            when Tok_Until_Em_Un =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Until, Res, True, True);
             when Tok_Before =>
                if Prio > Prio_FL_Bounding then
                   return Res;
                end if;
-               Res := Parse_St_Binary_FL_Property (N_Before, Res);
+               Res := Parse_St_Binary_FL_Property
+                 (N_Before, Res, False, False);
+            when Tok_Before_Em =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Before, Res, True, False);
+            when Tok_Before_Un =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Before, Res, False, True);
+            when Tok_Before_Em_Un =>
+               if Prio > Prio_FL_Bounding then
+                  return Res;
+               end if;
+               Res := Parse_St_Binary_FL_Property (N_Before, Res, True, True);
             when Tok_Or =>
                if Prio > Prio_Seq_Or then
                   return Res;
diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index fd9cb2a24..2ce6c3aac 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -2026,7 +2026,7 @@ package body Vhdl.Prints is
             Print_Property (Ctxt, Get_Property (Prop), Prio);
             Disp_Token (Ctxt, Tok_Right_Paren);
          when N_Eventually =>
-            Disp_Token (Ctxt, Tok_Eventually, Tok_Left_Paren);
+            Disp_Token (Ctxt, Tok_Eventually_Em, Tok_Left_Paren);
             Print_Property (Ctxt, Get_Property (Prop), Prio);
             Disp_Token (Ctxt, Tok_Right_Paren);
          when N_Strong =>
diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb
index d0b2910bc..d01739a20 100644
--- a/src/vhdl/vhdl-scanner.adb
+++ b/src/vhdl/vhdl-scanner.adb
@@ -1090,8 +1090,7 @@ package body Vhdl.Scanner is
 
       if Source (P - 1) = '_' then
          if Allow_PSL then
-            --  Some PSL reserved words finish with '_'.  This case is handled
-            --  later by Scan_Underscore and Scan_Exclam_Mark.
+            --  Some PSL reserved words finish with '_'.
             P := P - 1;
             Len := Len - 1;
             C := '_';
@@ -1232,6 +1231,37 @@ package body Vhdl.Scanner is
       Current_Token := Tok_Identifier;
    end Scan_Identifier;
 
+   procedure Scan_Psl_Keyword_Em (Tok : Token_Type; Tok_Em : Token_Type) is
+   begin
+      if Source (Pos) = '!' then
+         Pos := Pos + 1;
+         Current_Token := Tok_Em;
+      else
+         Current_Token := Tok;
+      end if;
+   end Scan_Psl_Keyword_Em;
+   pragma Inline (Scan_Psl_Keyword_Em);
+
+   procedure Scan_Psl_Keyword_Em_Un
+     (Tok, Tok_Em, Tok_Un, Tok_Em_Un : Token_Type) is
+   begin
+      if Source (Pos) = '!' then
+         Pos := Pos + 1;
+         if Source (Pos) = '_' then
+            Pos := Pos + 1;
+            Current_Token := Tok_Em_Un;
+         else
+            Current_Token := Tok_Em;
+         end if;
+      elsif Source (Pos) = '_' then
+         Pos := Pos + 1;
+         Current_Token := Tok_Un;
+      else
+         Current_Token := Tok;
+      end if;
+   end Scan_Psl_Keyword_Em_Un;
+   pragma Inline (Scan_Psl_Keyword_Em_Un);
+
    procedure Identifier_To_Token is
    begin
       if Current_Identifier in Std_Names.Name_Id_Keywords then
@@ -1319,7 +1349,14 @@ package body Vhdl.Scanner is
                   Current_Token := Tok_Identifier;
                end if;
             when Std_Names.Name_Id_Vhdl87_Reserved_Words =>
-               null;
+               if Flag_Psl then
+                  if Current_Token = Tok_Until then
+                     Scan_Psl_Keyword_Em_Un (Tok_Until, Tok_Until_Em,
+                                             Tok_Until_Un, Tok_Until_Em_Un);
+                  elsif Current_Token = Tok_Next then
+                     Scan_Psl_Keyword_Em (Tok_Next, Tok_Next_Em);
+                  end if;
+               end if;
             when others =>
                raise Program_Error;
          end case;
@@ -1354,25 +1391,31 @@ package body Vhdl.Scanner is
             when Std_Names.Name_Abort =>
                Current_Token := Tok_Abort;
             when Std_Names.Name_Before =>
-               Current_Token := Tok_Before;
+               Scan_Psl_Keyword_Em_Un (Tok_Before, Tok_Before_Em,
+                                       Tok_Before_Un, Tok_Before_Em_Un);
             when Std_Names.Name_Always =>
                Current_Token := Tok_Always;
             when Std_Names.Name_Never =>
                Current_Token := Tok_Never;
             when Std_Names.Name_Eventually =>
-               Current_Token := Tok_Eventually;
+               if Source (Pos) = '!' then
+                  Pos := Pos + 1;
+               else
+                  Error_Msg_Scan ("'!' expected after 'eventually'");
+               end if;
+               Current_Token := Tok_Eventually_Em;
             when Std_Names.Name_Next_A =>
-               Current_Token := Tok_Next_A;
+               Scan_Psl_Keyword_Em (Tok_Next_A, Tok_Next_A_Em);
             when Std_Names.Name_Next_E =>
-               Current_Token := Tok_Next_E;
+               Scan_Psl_Keyword_Em (Tok_Next_E, Tok_Next_E_Em);
             when Std_Names.Name_Next_Event =>
-               Current_Token := Tok_Next_Event;
+               Scan_Psl_Keyword_Em (Tok_Next_Event, Tok_Next_Event_Em);
             when Std_Names.Name_Next_Event_A =>
-               Current_Token := Tok_Next_Event_A;
+               Scan_Psl_Keyword_Em (Tok_Next_Event_A, Tok_Next_Event_A_Em);
             when Std_Names.Name_Next_Event_E =>
-               Current_Token := Tok_Next_Event_E;
+               Scan_Psl_Keyword_Em (Tok_Next_Event_E, Tok_Next_Event_E_Em);
             when Std_Names.Name_Until =>
-               Current_Token := Tok_Until;
+               raise Internal_Error;
             when others =>
                Current_Token := Tok_Identifier;
                if Source (Pos - 1) = '_' then
@@ -1834,26 +1877,6 @@ package body Vhdl.Scanner is
       return False;
    end Scan_Comment;
 
-   function Scan_Exclam_Mark return Boolean is
-   begin
-      if Source (Pos) = '!' then
-         Pos := Pos + 1;
-         return True;
-      else
-         return False;
-      end if;
-   end Scan_Exclam_Mark;
-
-   function Scan_Underscore return Boolean is
-   begin
-      if Source (Pos) = '_' then
-         Pos := Pos + 1;
-         return True;
-      else
-         return False;
-      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.
diff --git a/src/vhdl/vhdl-scanner.ads b/src/vhdl/vhdl-scanner.ads
index 461c431df..21186a0a3 100644
--- a/src/vhdl/vhdl-scanner.ads
+++ b/src/vhdl/vhdl-scanner.ads
@@ -106,14 +106,6 @@ package Vhdl.Scanner is
    --  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
-   --  False (used by PSL).
-   function Scan_Exclam_Mark return Boolean;
-
-   --  If the next character is '_', eat it and return True, otherwise return
-   --  False (used by PSL).
-   function Scan_Underscore return Boolean;
-
    --  Get the current location, or the location of the current token.
    --  Since a token cannot spread over lines, file and line of the current
    --  token are the same as those of the current position.
diff --git a/src/vhdl/vhdl-tokens.adb b/src/vhdl/vhdl-tokens.adb
index 089f8173f..7e5633f16 100644
--- a/src/vhdl/vhdl-tokens.adb
+++ b/src/vhdl/vhdl-tokens.adb
@@ -464,18 +464,30 @@ package body Vhdl.Tokens is
             return "always";
          when Tok_Never =>
             return "never";
-         when Tok_Eventually =>
-            return "eventually";
+         when Tok_Eventually_Em =>
+            return "eventually!";
+         when Tok_Next_Em =>
+            return "next!";
          when Tok_Next_A =>
             return "next_a";
+         when Tok_Next_A_Em =>
+            return "next_a!";
          when Tok_Next_E =>
             return "next_e";
+         when Tok_Next_E_Em =>
+            return "next_e!";
          when Tok_Next_Event =>
             return "next_event";
+         when Tok_Next_Event_Em =>
+            return "next_event!";
          when Tok_Next_Event_A =>
             return "next_event_a";
+         when Tok_Next_Event_A_Em =>
+            return "next_event_a!";
          when Tok_Next_Event_E =>
             return "next_event_e";
+         when Tok_Next_Event_E_Em =>
+            return "next_event_e!";
       end case;
    end Image;
 
diff --git a/src/vhdl/vhdl-tokens.ads b/src/vhdl/vhdl-tokens.ads
index 93b3c77a2..3efc165ed 100644
--- a/src/vhdl/vhdl-tokens.ads
+++ b/src/vhdl/vhdl-tokens.ads
@@ -279,17 +279,23 @@ package Vhdl.Tokens is
       Tok_Before_Em,
       Tok_Before_Un,
       Tok_Before_Em_Un,
-      Tok_Until_Em,
-      Tok_Until_Un,
-      Tok_Until_Em_Un,
       Tok_Always,
       Tok_Never,
-      Tok_Eventually,
+      Tok_Eventually_Em,
+      Tok_Next_Em,
       Tok_Next_A,
+      Tok_Next_A_Em,
       Tok_Next_E,
+      Tok_Next_E_Em,
       Tok_Next_Event,
+      Tok_Next_Event_Em,
       Tok_Next_Event_A,
-      Tok_Next_Event_E
+      Tok_Next_Event_A_Em,
+      Tok_Next_Event_E,
+      Tok_Next_Event_E_Em,
+      Tok_Until_Em,
+      Tok_Until_Un,
+      Tok_Until_Em_Un
      );
 
    --  To ease interfacing