opentoken_6.0.3_b278f6ad/Test/analyzer_lookahead_test.adb

-------------------------------------------------------------------------------
--
--  Copyright (C) 2009, 2010, 2012, 2013, 2014 Stephen Leake
--  Copyright (C) 2000 Ted Dennison
--
--  This file is part of the OpenToken package.
--
--  The OpenToken package is free software; you can redistribute it
--  and/or modify it under the terms of the GNU General Public License
--  as published by the Free Software Foundation; either version 3, or
--  (at your option) any later version. The OpenToken package is
--  distributed in the hope that it will be useful, but WITHOUT ANY
--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
--  FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
--  License for more details. You should have received a copy of the
--  GNU General Public License distributed with the OpenToken package;
--  see file GPL.txt. If not, write to the Free Software Foundation,
--  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

pragma License (GPL);

with AUnit.Assertions;
with AUnit.Check;
with Ada.Tags;
with Ada.Text_IO;
with OpenToken.Recognizer.Character_Set;
with OpenToken.Recognizer.End_Of_File;
with OpenToken.Recognizer.Keyword;
with OpenToken.Recognizer.String;
with OpenToken.Text_Feeder.String;
with OpenToken.Token.Enumerated.Analyzer.AUnit;
with OpenToken.Token.Enumerated.String;
package body Analyzer_Lookahead_Test is

   type Token_ID is (If_ID, Then_ID, Quit_ID, String_ID, Whitespace, EOF);

   package Master_Example_Token is new OpenToken.Token.Enumerated
     (Token_ID, Token_ID'First, Token_ID'Last, Token_ID'Image);
   package Tokenizer is new Master_Example_Token.Analyzer;
   package String_Literal is new Master_Example_Token.String;

   procedure Check is new AUnit.Check.Gen_Check_Discrete (Token_ID);

   package Analyzer_AUnit is new Tokenizer.AUnit (Check);

   Syntax : constant Tokenizer.Syntax :=
     (If_ID      => Tokenizer.Get (OpenToken.Recognizer.Keyword.Get ("if")),
      Then_ID    => Tokenizer.Get (OpenToken.Recognizer.Keyword.Get ("then")),
      Quit_ID    => Tokenizer.Get (OpenToken.Recognizer.Keyword.Get ("quit")),
      String_ID  => Tokenizer.Get (OpenToken.Recognizer.String.Get,
                                   New_Token => String_Literal.Get (String_ID)),
      Whitespace => Tokenizer.Get (OpenToken.Recognizer.Character_Set.Get
                                     (OpenToken.Recognizer.Character_Set.Standard_Whitespace)),
      EOF => Tokenizer.Get (OpenToken.Recognizer.End_Of_File.Get));

   Feeder   : aliased OpenToken.Text_Feeder.String.Instance;
   Analyzer : constant Tokenizer.Handle := Tokenizer.Initialize (Syntax, Feeder'Access);

   procedure Step
     (Label       : in String;
      Lookahead   : in Boolean;
      Expected_ID : in Token_ID)
   is
      use Tokenizer;
   begin
      Analyzer.Find_Next (Lookahead);

      Check (Label, Analyzer.ID, Expected_ID);
   end Step;

   ----------
   --  Test procedures

   procedure Lookahead (T : in out AUnit.Test_Cases.Test_Case'Class)
   is
      pragma Unreferenced (T);

      Text : constant String := """This is a standard WSIWG """"Ada"""" string \n.""if then quit";
   begin
      ---------------------------------------------------------------------------
      --  Purpose          : Verify that the analyzer tokenizes properly in
      --                     lookahead mode.
      --  Input            : A string, followed by an "if", a "then" and a "quit"
      --                     token.
      --  Expected Results : The tokens should be returned in the correct order.
      --                     When non-lookahead calls to Find_Next resume, the
      --                     sequence of tokens should resume from right after
      --                     where it left off.
      ---------------------------------------------------------------------------

      OpenToken.Text_Feeder.String.Set (Feeder, Text);
      Analyzer.Reset;

      Step ("1", False, String_ID);
      Step ("2", True, If_ID);
      Step ("3", True, Then_ID);
      Step ("4", True, Quit_ID);
      Step ("5", True, EOF);

      Step ("6", False, If_ID);
      Step ("7", False, Then_ID);
      Step ("8", False, Quit_ID);

   end Lookahead;

   procedure Lookahead_Push_Back (T : in out AUnit.Test_Cases.Test_Case'Class)
   is
      Test : Test_Case renames Test_Case (T);
      use Tokenizer;

   begin
      --  Verify that Push_Back works.

      OpenToken.Trace_Parse := Test.Trace_Parse;

      OpenToken.Text_Feeder.String.Set (Feeder, "if then ""string"" quit");
      Analyzer.Reset;

      Analyzer_AUnit.Check
        ("0", Analyzer,
         Last_Token  => If_ID,
         Tail_Null   => True,
         Queue_Null  => True,
         Head_Null   => True);

      Step ("1", False, If_ID);

      Analyzer_AUnit.Check
        ("1a", Analyzer,
         Last_Token  => If_ID,
         Tail_Null   => True,
         Queue_Null  => True,
         Head_Null   => True);

      declare
         Mark : OpenToken.Token.Queue_Mark'Class renames Analyzer.Mark_Push_Back;
      begin
         Step ("2", True, Then_ID);

         Analyzer_AUnit.Check
           ("2a", Analyzer,
            Last_Token  => Then_ID,
            Tail_Tokens => (If_ID, Then_ID),
            Queue_Token => Then_ID,
            Head_Null   => True);

         Analyzer.Push_Back (Mark);
      end;

      Analyzer_AUnit.Check
        ("3", Analyzer,
         Last_Token  => If_ID,
         Tail_Tokens => (If_ID, Then_ID),
         Queue_Token => Then_ID,
         Head_Token  => Then_ID);

      declare
         Mark_2 : OpenToken.Token.Queue_Mark'Class renames Analyzer.Mark_Push_Back;
      begin
         Step ("4", True, Then_ID);

         Analyzer_AUnit.Check
           ("4a", Analyzer,
            Last_Token  => Then_ID,
            Tail_Tokens => (If_ID, Then_ID),
            Queue_Token => Then_ID,
            Head_Null   => True);

         Step ("5", True, String_ID);

         Analyzer_AUnit.Check
           ("5a", Analyzer,
            Last_Token  => String_ID,
            Tail_Tokens => (If_ID, Then_ID, String_ID),
            Queue_Token => Then_ID,
            Head_Null   => True);

         declare
            Mark_1 : OpenToken.Token.Queue_Mark'Class renames Analyzer.Mark_Push_Back;
         begin
            Step ("6", True, Quit_ID);

            Analyzer_AUnit.Check
              ("6a", Analyzer,
               Last_Token  => Quit_ID,
               Tail_Tokens => (If_ID, Then_ID, String_ID, Quit_ID),
               Queue_Token => Then_ID,
               Head_Null   => True);

            Analyzer.Push_Back (Mark_1);
         end;

         Analyzer_AUnit.Check
           ("7", Analyzer,
            Last_Token  => String_ID,
            Tail_Tokens => (If_ID, Then_ID, String_ID, Quit_ID),
            Queue_Token => Then_ID,
            Head_Token  => Quit_ID);

         Analyzer.Push_Back (Mark_2);
      end;

      Analyzer_AUnit.Check
        ("7a", Analyzer,
         Last_Token  => If_ID,
         Tail_Tokens => (If_ID, Then_ID, String_ID, Quit_ID),
         Queue_Token => Then_ID,
         Head_Token  => Then_ID);

      Step ("8", True, Then_ID);
      Step ("9", False, Then_ID);

      Analyzer_AUnit.Check
        ("9a", Analyzer,
         Last_Token  => Then_ID,
         Tail_Tokens => (Then_ID, String_ID, Quit_ID),
         Queue_Token => String_ID,
         Head_Token  => String_ID);

      Step ("10", False, String_ID);

      declare
         Mark : OpenToken.Token.Queue_Mark'Class renames Analyzer.Mark_Push_Back;
      begin
         Step ("11", True, Quit_ID);

         Analyzer_AUnit.Check
           ("11a", Analyzer,
            Last_Token  => Quit_ID,
            Tail_Tokens => (String_ID, Quit_ID),
            Queue_Token => Quit_ID,
            Head_Null   => True);

         Analyzer.Push_Back (Mark);
      end;

      Analyzer_AUnit.Check
        ("11b", Analyzer,
         Last_Token  => String_ID,
         Tail_Tokens => (String_ID, Quit_ID),
         Queue_Token => Quit_ID,
         Head_Token  => Quit_ID);

      Step ("12", False, Quit_ID);
      Step ("13", False, EOF);

      Analyzer_AUnit.Check
        ("13a", Analyzer,
         Last_Token => EOF,
         Tail_Null  => True,
         Queue_Null => True,
         Head_Null  => True);

   end Lookahead_Push_Back;

   procedure Check_Lexeme
     (Label           : in     String;
      Token           : in     Master_Example_Token.Handle;
      Expected_Lexeme : access String)
   is
      use AUnit.Check;
   begin
      if Expected_Lexeme /= null then
         declare
            String_Token : String_Literal.Instance renames String_Literal.Instance (Token.all);
         begin
            Check (Label & ".lexeme", String_Literal.To_String (String_Token.Value), Expected_Lexeme.all);
         end;
      end if;
   end Check_Lexeme;

   procedure Lookahead_Lexemes (T : in out AUnit.Test_Cases.Test_Case'Class)
   is
      Text : constant String := """string 1"" ""string 2"" ";

      String_1_Value : aliased String := "string 1";
      String_2_Value : aliased String := "string 2";

      String_Token : aliased String_Literal.Instance := String_Literal.Instance (String_Literal.Get (String_ID));

      procedure Test
        (Label           : in     String;
         Actively        : in     Boolean;
         Token           : access Master_Example_Token.Class;
         Expected_Lexeme : in     String                := "")
      is
         use AUnit.Check;
         use type Ada.Tags.Tag;
      begin
         Master_Example_Token.Parse (Token, Analyzer, Actively);
         Check
           (Label & ".lexeme", String_Literal.To_String (String_Literal.Instance (Token.all).Value), Expected_Lexeme);
      end Test;

   begin
      --  Verify that tokens preserve lexemes when parsing inactively,
      --  even if the tokens are repeated.

      if Test_Case (T).Trace_Parse > 0 then
         Ada.Text_IO.Put_Line ("Lookahead_Lexemes");
      end if;

      OpenToken.Text_Feeder.String.Set (Feeder, Text);
      Analyzer.Reset;

      --  The very first call to find_next can't be look_ahead =>
      --  true, since no real parser would do that.
      Analyzer.Find_Next (Look_Ahead => False);

      declare
         Mark : OpenToken.Token.Queue_Mark'Class renames Analyzer.Mark_Push_Back;
      begin
         --  Lexemes are not copied to tokens during inactive parse,
         --  but they are copied into the tokens pushed on the queue,
         --  so we check that here.
         String_Literal.Parse (String_Token'Access, Analyzer, Actively => False);

         Analyzer_AUnit.Check
           ("1p", Analyzer,
            Last_Token   => String_ID,
            Tail_Tokens  => (String_ID, String_ID),
            Tail_Lexemes => (String_1_Value'Unchecked_Access, String_2_Value'Unchecked_Access),
            Queue_Token  => String_ID,
            Head_Null    => True,
            Check_Token  => Check_Lexeme'Access);

         String_Literal.Parse (String_Token'Access, Analyzer, Actively => False);

         Analyzer_AUnit.Check
           ("2p", Analyzer,
            Last_Token   => EOF,
            Tail_Tokens  => (String_ID, String_ID, EOF),
            Tail_Lexemes => (String_1_Value'Unchecked_Access, String_2_Value'Unchecked_Access, null),
            Queue_Token  => String_ID,
            Head_Null    => True,
            Check_Token  => Check_Lexeme'Access);

         Analyzer.Push_Back (Mark);
      end;

      --  The lexemes were preserved by Copy, so they are correct here
      Test ("1a", True, String_Token'Access, "string 1");
      Test ("2a", True, String_Token'Access, "string 2");

   end Lookahead_Lexemes;

   procedure Mismatched_Tokens (T : in out AUnit.Test_Cases.Test_Case'Class)
   is
      pragma Unreferenced (T);

      Text : constant String := """string 1"" ";

      Bad_String_Token : aliased Master_Example_Token.Class := Master_Example_Token.Get (String_ID);

   begin
      --  Verify the error from Parse when called with a token type
      --  that doesn't match the one in Syntax_List. This test doesn't
      --  do lookahead, but it tests a run-time check required by the
      --  lookahead design.

      OpenToken.Text_Feeder.String.Set (Feeder, Text);
      Analyzer.Reset;
      Analyzer.Find_Next (Look_Ahead => False);

      begin
         Master_Example_Token.Parse (Bad_String_Token'Access, Analyzer, Actively => True);
         AUnit.Assertions.Assert (False, "did not get exception");
      exception
      when OpenToken.Programmer_Error =>
         null;
      end;
   end Mismatched_Tokens;

   ----------
   --  Public subprograms

   overriding function Name (T : Test_Case) return AUnit.Message_String
   is
      pragma Unreferenced (T);
   begin
      return new String'("../../Test/analyzer_lookahead_test.adb");
   end Name;

   overriding procedure Register_Tests (T : in out Test_Case)
   is
      use AUnit.Test_Cases.Registration;
   begin
      Register_Routine (T, Lookahead'Access, "Lookahead");
      Register_Routine (T, Lookahead_Push_Back'Access, "Lookahead_Push_Back");
      Register_Routine (T, Lookahead_Lexemes'Access, "Lookahead_Lexemes");
      Register_Routine (T, Mismatched_Tokens'Access, "Mismatched_Tokens");
   end Register_Tests;

end Analyzer_Lookahead_Test;