1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158 | -- Abstract :
--
-- See spec.
--
-- Copyright (C) 2009, 2010, 2012, 2013, 2014 Stephen Leake. All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 3, or (at
-- your option) any later version. This program 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 this program; see file COPYING. 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 Ada.Exceptions;
with Ada.Strings.Maps.Constants;
with OpenToken.Production.List;
with OpenToken.Production.Parser.LALR.Generator;
with OpenToken.Production.Parser.LALR.Parser;
with OpenToken.Production.Parser.LALR.Parser_Lists;
with OpenToken.Recognizer.Based_Integer;
with OpenToken.Recognizer.Character_Set;
with OpenToken.Recognizer.End_Of_File;
with OpenToken.Recognizer.Identifier;
with OpenToken.Recognizer.Keyword;
with OpenToken.Recognizer.Separator;
with OpenToken.Text_Feeder.String;
with OpenToken.Token.Enumerated.Analyzer;
with OpenToken.Token.Enumerated.Integer;
with OpenToken.Token.Enumerated.List;
with OpenToken.Token.Enumerated.Nonterminal;
package body Test_Accept_Index is
-- A simple grammar that OpenToken used to get wrong.
--
-- set foo = integer;
type Token_IDs is
(Whitespace_ID,
Equals_ID,
Int_ID,
Set_ID,
EOF_ID,
Identifier_ID,
-- non-terminals
Parse_Sequence_ID,
Statement_ID);
-- Instantiate all the necessary packages
package Master_Token is new OpenToken.Token.Enumerated (Token_IDs, Equals_ID, Identifier_ID, Token_IDs'Image);
package Tokenizer is new Master_Token.Analyzer;
package Token_List is new Master_Token.List;
package Nonterminal is new Master_Token.Nonterminal (Token_List);
package Production is new OpenToken.Production (Master_Token, Token_List, Nonterminal);
package Production_List is new Production.List;
package OpenToken_Parser is new Production.Parser (Tokenizer);
package LALRs is new OpenToken_Parser.LALR (First_State_Index => 1);
package Parser_Lists is new LALRs.Parser_Lists (First_Parser_Label => 1);
package LALR_Parser is new LALRs.Parser (1, Parser_Lists);
package LALR_Generator is new LALRs.Generator (Token_IDs'Width, Production_List);
package Integer_Literal is new Master_Token.Integer;
-- Define all our tokens
Equals : constant Master_Token.Class := Master_Token.Get (Equals_ID);
Int : constant Master_Token.Class := Integer_Literal.Get (Int_ID);
EOF : constant Master_Token.Class := Master_Token.Get (EOF_ID);
Identifier : constant Master_Token.Class := Master_Token.Get (Identifier_ID);
Parse_Sequence : constant Nonterminal.Class := Nonterminal.Get (Parse_Sequence_ID);
Statement : constant Nonterminal.Class := Nonterminal.Get (Statement_ID);
Syntax : constant Tokenizer.Syntax :=
(Equals_ID => Tokenizer.Get (OpenToken.Recognizer.Separator.Get ("="), Master_Token.Get (Equals_ID, "=")),
Int_ID => Tokenizer.Get (OpenToken.Recognizer.Based_Integer.Get, Int),
Set_ID => Tokenizer.Get (OpenToken.Recognizer.Keyword.Get ("set"), Master_Token.Get (Set_ID, "set")),
EOF_ID => Tokenizer.Get (OpenToken.Recognizer.End_Of_File.Get, Master_Token.Get (EOF_ID)),
Identifier_ID => Tokenizer.Get
(OpenToken.Recognizer.Identifier.Get
(Start_Chars => Ada.Strings.Maps.Constants.Letter_Set,
Body_Chars => Ada.Strings.Maps.Constants.Alphanumeric_Set),
Master_Token.Get (Identifier_ID, "identifier")),
Whitespace_ID => Tokenizer.Get
(OpenToken.Recognizer.Character_Set.Get (OpenToken.Recognizer.Character_Set.Standard_Whitespace)));
use type Production.Instance; -- "<="
use type Production_List.Instance; -- "and"
use type Production.Right_Hand_Side; -- "+"
use type Token_List.Instance; -- "&"
Grammar : constant Production_List.Instance :=
-- First production in Grammar must be the terminating
-- production; it gets the accept action.
Parse_Sequence <= Statement & EOF and
Statement <= Master_Token.Get (Set_ID) & Identifier & Equals & Int + Nonterminal.Synthesize_Self;
String_Feeder : aliased OpenToken.Text_Feeder.String.Instance;
Parser : LALR_Parser.Instance;
----------
-- Test procedures
procedure Nominal (T : in out AUnit.Test_Cases.Test_Case'Class)
is
Test : Test_Case renames Test_Case (T);
begin
-- The test is that there are no exceptions.
Parser := LALR_Parser.Initialize
(Tokenizer.Initialize (Syntax),
LALR_Generator.Generate
(Grammar,
Trace => Test.Debug,
Put_Parse_Table => Test.Debug));
OpenToken.Trace_Parse := (if Test.Debug then 1 else 0);
LALR_Parser.Set_Text_Feeder (Parser, String_Feeder'Unchecked_Access);
OpenToken.Text_Feeder.String.Set (String_Feeder, "set A = 2");
LALR_Parser.Parse (Parser);
exception
when E : others =>
declare
use Ada.Exceptions;
begin
AUnit.Assertions.Assert (False, Exception_Name (E) & ": " & Exception_Message (E));
end;
end Nominal;
----------
-- Public subprograms
overriding function Name (T : Test_Case) return AUnit.Message_String
is
pragma Unreferenced (T);
begin
return new String'("../../Test/test_accept_index.adb");
end Name;
overriding procedure Register_Tests (T : in out Test_Case)
is
use AUnit.Test_Cases.Registration;
begin
Register_Routine (T, Nominal'Access, "Nominal");
end Register_Tests;
end Test_Accept_Index;
|