Skip to content

Commit 11ccf0b

Browse files
koenmeersmankoenmeersman
authored
Merge 588aa20 into 8933d0f 
2 parents 8933d0f + 588aa20 commit 11ccf0b

File tree

4 files changed

+201
-4
lines changed

4 files changed

+201
-4
lines changed

‎Units/parser-ada.r/ada-label.d/args.ctags

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
--sort=no
2+
--kinds-Ada=""
3+
--kinds-Ada=+{label}

‎Units/parser-ada.r/ada-label.d/expected.tags

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
Null_Before_Label input.adb /^ <<Null_Before_Label>> null; <<Null_After_Label>>$/;" b subprogram:Input file:
2+
Null_After_Label input.adb /^ <<Null_Before_Label>> null; <<Null_After_Label>>$/;" b subprogram:Input file:
3+
Assignment_Before_Label input.adb /^ <<Assignment_Before_Label>> X := 1; <<Assignment_After_Label>>$/;" b subprogram:Input file:
4+
Assignment_After_Label input.adb /^ <<Assignment_Before_Label>> X := 1; <<Assignment_After_Label>>$/;" b subprogram:Input file:
5+
Exit_Before_Label input.adb /^ <<Exit_Before_Label>> exit; <<Exit_After_Label>>$/;" b anon:loop file:
6+
Exit_After_Label input.adb /^ <<Exit_Before_Label>> exit; <<Exit_After_Label>>$/;" b anon:loop file:
7+
Goto_Before_Label input.adb /^ <<Goto_Before_Label>> goto Assignment_Before_Label; <<Goto_After_Label>>$/;" b anon:loop file:
8+
Goto_After_Label input.adb /^ <<Goto_Before_Label>> goto Assignment_Before_Label; <<Goto_After_Label>>$/;" b anon:loop file:
9+
Procedure_Call_Before_Label input.adb /^ <<Procedure_Call_Before_Label>> Ada.Text_IO.Put_Line ("Hello World"); <<Procedure_Call_After_L/;" b subprogram:Input file:
10+
Procedure_Call_After_Label input.adb /^ <<Procedure_Call_Before_Label>> Ada.Text_IO.Put_Line ("Hello World"); <<Procedure_Call_After_L/;" b subprogram:Input file:
11+
Return_Before_Label input.adb /^ <<Return_Before_Label>> return; <<Return_After_Label>>$/;" b subprogram:Input file:
12+
Return_After_Label input.adb /^ <<Return_Before_Label>> return; <<Return_After_Label>>$/;" b subprogram:Input file:
13+
Accept_Before_Label input.adb /^ <<Accept_Before_Label>> accept Start(Nr : in Natural) do$/;" b task:Server file:
14+
Requeue_Before_Label input.adb /^ <<Requeue_Before_Label>> requeue Start; <<Requeue_After_Label>>$/;" b entry:Start file:
15+
Requeue_After_Label input.adb /^ <<Requeue_Before_Label>> requeue Start; <<Requeue_After_Label>>$/;" b entry:Start file:
16+
Accept_After_Label input.adb /^ end Start; <<Accept_After_Label>>$/;" b task:Server file:
17+
Entry_Before_Label input.adb /^ <<Entry_Before_Label>> My_Task.Start (1); <<Entry_After_Label>>$/;" b anon:declare file:
18+
Entry_After_Label input.adb /^ <<Entry_Before_Label>> My_Task.Start (1); <<Entry_After_Label>>$/;" b anon:declare file:
19+
Delay_Before_Label input.adb /^ <<Delay_Before_Label>> delay 100.0; <<Delay_After_Label>>$/;" b anon:declare file:
20+
Delay_After_Label input.adb /^ <<Delay_Before_Label>> delay 100.0; <<Delay_After_Label>>$/;" b anon:declare file:
21+
Abort_Before_Label input.adb /^ <<Abort_Before_Label>> abort My_Task; <<Abort_After_Label>>$/;" b anon:declare file:
22+
Abort_After_Label input.adb /^ <<Abort_Before_Label>> abort My_Task; <<Abort_After_Label>>$/;" b anon:declare file:
23+
Select_Before_Statement input.adb /^ <<Select_Before_Statement>> select$/;" b anon:declare file:
24+
Select_After_Statement input.adb /^ end select; <<Select_After_Statement>>$/;" b task:Server file:
25+
Code_Before_Label input.adb /^ <<Code_Before_Label>>$/;" b task:Server file:
26+
Code_After_Label input.adb /^ <<Code_After_Label>>$/;" b task:Server file:
27+
Multiple_1_Before_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
28+
Multiple_2_Before_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
29+
Multiple_3_Before_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
30+
Multiple_1_After_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
31+
Multiple_2_After_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
32+
Multiple_3_After_Label input.adb /^ <<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Mu/;" b task:Server file:
33+
Raise_Before_Label input.adb /^ <<Raise_Before_Label>> raise constraint_error; <<Raise_After_Label>>$/;" b task:Server file:
34+
Raise_After_Label input.adb /^ <<Raise_Before_Label>> raise constraint_error; <<Raise_After_Label>>$/;" b task:Server file:
35+
If_Before_Label input.adb /^ <<If_Before_Label>> if X>1 then$/;" b task:Server file:
36+
If_After_Label input.adb /^ end if; <<If_After_Label>> $/;" b task:Server file:
37+
Case_Before_Label input.adb /^ <<Case_Before_Label>> case X is$/;" b task:Server file:
38+
Case_Code_Before_Label input.adb /^ when 1 => <<Case_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Case_Code_After_Label>> $/;" b task:Server file:
39+
Case_Code_After_Label input.adb /^ when 1 => <<Case_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Case_Code_After_Label>> $/;" b task:Server file:
40+
Case_After_Label input.adb /^ end case; <<Case_After_Label>>$/;" b task:Server file:
41+
Loop_Before_Label input.adb /^ <<Loop_Before_Label>> loop $/;" b task:Server file:
42+
Loop_Code_Before_Label input.adb /^ <<Loop_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Loop_Code_After_Label>>$/;" b anon:loop file:
43+
Loop_Code_After_Label input.adb /^ <<Loop_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Loop_Code_After_Label>>$/;" b anon:loop file:
44+
Loop_After_Label input.adb /^ end loop; <<Loop_After_Label>>$/;" b task:Server file:
45+
While_Before_Label input.adb /^ <<While_Before_Label>> while X > 1 loop$/;" b task:Server file:
46+
While_Code_Before_Label input.adb /^ <<While_Code_Before_Label>> X := X + 1; <<While_Code_After_Label>>$/;" b anon:loop file:
47+
While_Code_After_Label input.adb /^ <<While_Code_Before_Label>> X := X + 1; <<While_Code_After_Label>>$/;" b anon:loop file:
48+
While_After_Label input.adb /^ end loop; <<While_After_Label>>$/;" b task:Server file:
49+
For_Before_Label input.adb /^ <<For_Before_Label>> for I in 1 .. X loop$/;" b task:Server file:
50+
For_Code_Before_Label input.adb /^ <<For_Code_Before_Label>> Ada.Text_IO.Put_Line (X'Image); <<For_Code_After_Label>> $/;" b anon:loop file:
51+
For_Code_After_Label input.adb /^ <<For_Code_Before_Label>> Ada.Text_IO.Put_Line (X'Image); <<For_Code_After_Label>> $/;" b anon:loop file:
52+
For_After_Label input.adb /^ end loop; <<For_After_Label>>$/;" b task:Server file:
53+
Declare_Before_Label input.adb /^ <<Declare_Before_Label>> declare$/;" b task:Server file:
54+
Declare_After_Label input.adb /^ end; <<Declare_After_Label>>$/;" b task:Server file:
55+
Begin_Before_Label input.adb /^ <<Begin_Before_Label>> begin$/;" b task:Server file:
56+
Begin_After_Label input.adb /^ end; <<Begin_After_Label>>$/;" b task:Server file:
57+
Return_Before_Label input.adb /^ <<Return_Before_Label>> return Coord : Coordinate do$/;" b subprogram:Extended_Return file:
58+
Return_After_Label input.adb /^ end return; <<Return_After_Label>>$/;" b subprogram:Extended_Return file:

‎Units/parser-ada.r/ada-label.d/input.adb

Lines changed: 133 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,133 @@
1+
-- Test labels
2+
-- See: ARM 5.1 : Simple and Compound Statements - Sequences of Statements
3+
--
4+
-- A label should come before a simple statement or a compound statment.
5+
--
6+
-- Check if file compiles: gnatmake -gnatc Units/parser-ada.r/ada-label.d/input.adb
7+
--
8+
with Ada.Text_IO;
9+
10+
procedure Input is
11+
X : Integer;
12+
begin
13+
-- ARM 5.1(4/2) : Simple statements
14+
-- null statement
15+
<<Null_Before_Label>> null; <<Null_After_Label>>
16+
17+
-- assignment
18+
<<Assignment_Before_Label>> X := 1; <<Assignment_After_Label>>
19+
20+
for I in 1 .. X loop
21+
if I > 1 then
22+
-- exit statement
23+
<<Exit_Before_Label>> exit; <<Exit_After_Label>>
24+
elsif I > 2 then
25+
-- goto statement
26+
<<Goto_Before_Label>> goto Assignment_Before_Label; <<Goto_After_Label>>
27+
end if;
28+
end loop;
29+
30+
-- procedure call statement
31+
<<Procedure_Call_Before_Label>> Ada.Text_IO.Put_Line ("Hello World"); <<Procedure_Call_After_Label>>
32+
if X > 1 then
33+
-- simple return statement
34+
<<Return_Before_Label>> return; <<Return_After_Label>>
35+
end if;
36+
37+
declare
38+
task type Server is
39+
entry Start(Nr : in Natural);
40+
end Server;
41+
42+
task body Server is
43+
Iden : Natural;
44+
begin
45+
<<Accept_Before_Label>> accept Start(Nr : in Natural) do
46+
Iden := Nr;
47+
<<Requeue_Before_Label>> requeue Start; <<Requeue_After_Label>>
48+
end Start; <<Accept_After_Label>>
49+
Ada.Text_IO.Put_Line ("Working...");
50+
end;
51+
52+
My_Task : Server;
53+
begin
54+
<<Entry_Before_Label>> My_Task.Start (1); <<Entry_After_Label>>
55+
<<Delay_Before_Label>> delay 100.0; <<Delay_After_Label>>
56+
<<Abort_Before_Label>> abort My_Task; <<Abort_After_Label>>
57+
if X > 1 then
58+
<<Select_Before_Statement>> select
59+
My_Task.Start (1);
60+
or
61+
delay 10.0;
62+
end select; <<Select_After_Statement>>
63+
end if;
64+
end;
65+
<<Code_Before_Label>>
66+
Ada.Text_IO.Put_Line ("Code 1");
67+
Ada.Text_IO.Put_Line ("Code 2");
68+
<<Code_After_Label>>
69+
<<Multiple_1_Before_Label>> <<Multiple_2_Before_Label>> <<Multiple_3_Before_Label>> null; <<Multiple_1_After_Label>> <<Multiple_2_After_Label>> <<Multiple_3_After_Label>>
70+
<<Raise_Before_Label>> raise constraint_error; <<Raise_After_Label>>
71+
72+
-- ARM 5.1(5/2) Compound statements
73+
-- if statement
74+
<<If_Before_Label>> if X>1 then
75+
Ada.Text_IO.Put_Line ("X>1");
76+
elsif X > 2 then
77+
Ada.Text_IO.Put_Line ("X > 2");
78+
end if; <<If_After_Label>>
79+
80+
-- case statement
81+
<<Case_Before_Label>> case X is
82+
when 1 => <<Case_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Case_Code_After_Label>>
83+
when 2 => Ada.Text_IO.Put_Line ("2");
84+
when others => Ada.Text_IO.Put_Line ("2");
85+
end case; <<Case_After_Label>>
86+
87+
-- loop statement
88+
<<Loop_Before_Label>> loop
89+
<<Loop_Code_Before_Label>> Ada.Text_IO.Put_Line ("1"); <<Loop_Code_After_Label>>
90+
exit;
91+
end loop; <<Loop_After_Label>>
92+
93+
<<While_Before_Label>> while X > 1 loop
94+
<<While_Code_Before_Label>> X := X + 1; <<While_Code_After_Label>>
95+
end loop; <<While_After_Label>>
96+
97+
<<For_Before_Label>> for I in 1 .. X loop
98+
<<For_Code_Before_Label>> Ada.Text_IO.Put_Line (X'Image); <<For_Code_After_Label>>
99+
end loop; <<For_After_Label>>
100+
101+
-- block statement
102+
<<Declare_Before_Label>> declare
103+
Y : Integer;
104+
begin
105+
Y := X + 1;
106+
Ada.Text_IO.Put_Line (Y'Image);
107+
end; <<Declare_After_Label>>
108+
109+
<<Begin_Before_Label>> begin
110+
null;
111+
end; <<Begin_After_Label>>
112+
113+
-- extended return statement
114+
declare
115+
type Coordinate is record
116+
X : Integer;
117+
Y : Integer;
118+
end record;
119+
120+
function Extended_Return return Coordinate is
121+
begin
122+
<<Return_Before_Label>> return Coord : Coordinate do
123+
Coord.X := 10;
124+
Coord.Y := 20;
125+
end return; <<Return_After_Label>>
126+
end Extended_Return;
127+
begin
128+
null;
129+
end;
130+
131+
-- accept statement See above <<Accept_Before_Label>> and <<Accept_After_Label>>
132+
-- select statement See above <<Select_Before_Statement>> and <<Select_After_Statement>>
133+
end Input;

‎parsers/ada.c

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -494,8 +494,10 @@ static void freeAdaToken(adaTokenList *list, adaTokenInfo *token)
494494
{
495495
token->prev->next = token->next;
496496
}
497-
else if(list != NULL && token->prev == NULL)
497+
else if(list != NULL)
498498
{
499+
/* Token to remove is head in list as 'token->prev == NULL' */
500+
Assert(token->prev == NULL);
499501
list->head = token->next;
500502
}
501503

@@ -504,8 +506,10 @@ static void freeAdaToken(adaTokenList *list, adaTokenInfo *token)
504506
{
505507
token->next->prev = token->prev;
506508
}
507-
else if(list != NULL && token->next == NULL)
509+
else if(list != NULL)
508510
{
511+
/* Token to remove is tail of list as 'token->next == NULL') */
512+
Assert(token->next == NULL);
509513
list->tail = token->prev;
510514
}
511515

@@ -2020,9 +2024,8 @@ static adaTokenInfo *adaParse(adaParseMode mode, adaTokenInfo *parent)
20202024
* found, if we didn't just fall through */
20212025
if((pos + i) < lineLen)
20222026
{
2023-
token = newAdaToken(&line[pos], i, ADA_KIND_LABEL, false, parent);
2027+
newAdaToken(&line[pos], i, ADA_KIND_LABEL, false, parent);
20242028
skipPast(">>");
2025-
token = NULL;
20262029
}
20272030
} /* else if(strncasecmp(line[pos], "<<", strlen("<<")) == 0) */
20282031
/* we need to check for a few special case keywords that might cause

0 commit comments

Comments
 (0)