« back to all changes in this revision
Viewing changes to asis/a4g-queries.adb
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Thomas Quinot
- Date: 2002-03-03 19:55:58 UTC
- Revision ID: james.westby@ubuntu.com-20020303195558-g7dp4vaq1zdkf814
Tags: upstream-3.14p
Import upstream version 3.14p
- files added:
- asis
- documentation
- examples
- examples/ds
- gnat
- obj
- templates
- tools
- tools/asistant
- tools/gnatelim
- tools/gnatstub
- tutorial
- tutorial/using_asistant
- tutorial/using_templets
- tutorial/using_templets/metrics
- tutorial/using_templets/metrics/task_1
- tutorial/using_templets/metrics/task_2
- tutorial/using_templets/style_ckecker
- tutorial/using_templets/style_ckecker/task_1
- tutorial/using_templets/style_ckecker/task_2
- tutorial/using_templets/test_units
added
removed
asis/a4g-queries.adb
1
------------------------------------------------------------------------------
2
-- --
3
-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS --
4
-- --
5
-- A 4 G . Q U E R I E S --
6
-- --
7
-- B o d y --
8
-- --
9
-- Copyright (c) 1995-2000, Free Software Foundation, Inc. --
10
-- --
11
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
12
-- under terms of the GNU General Public License as published by the Free --
13
-- Software Foundation; either version 2, or (at your option) any later --
14
-- version. ASIS-for-GNAT is distributed in the hope that it will be use- --
15
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
16
-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
17
-- Public License for more details. You should have received a copy of the --
18
-- GNU General Public License distributed with ASIS-for-GNAT; see file --
19
-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place --
20
-- - Suite 330, Boston, MA 02111-1307, USA. --
21
-- --
22
-- As a special exception, if other files instantiate generics from this --
23
-- unit, or you link this unit with other files to produce an executable, --
24
-- this unit does not by itself cause the resulting executable to be --
25
-- covered by the GNU General Public License. This exception does not --
26
-- however invalidate any other reasons why the executable file might be --
27
-- covered by the GNU Public License. --
28
-- --
29
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
30
-- Software Engineering Laboratory of the Swiss Federal Institute of --
31
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
32
-- Scientific Research Computer Center of Moscow State University (SRCC --
33
-- MSU), Russia, with funding partially provided by grants from the Swiss --
34
-- National Science Foundation and the Swiss Academy of Engineering --
35
-- Sciences. ASIS-for-GNAT is now maintained by Ada Core Technologies Inc --
36
-- (http://www.gnat.com). --
37
-- --
38
-- The original version of this component has been developed by Jean-Charles--
39
-- Marteau (Jean-Charles.Marteau@ensimag.imag.fr) and Serge Reboul --
40
-- (Serge.Reboul@ensimag.imag.fr), ENSIMAG High School Graduates (Computer --
41
-- sciences) Grenoble, France in Sema Group Grenoble, France. Now this --
42
-- component is maintained by the ASIS team --
43
-- --
44
------------------------------------------------------------------------------
45
46
--------------------------------------------------
47
-- The structure of this package is very basic, --
48
-- it consists in massive imbricated cases --
49
-- determining what element we're considering --
50
-- and returning an array containing its --
51
-- corresponding queries. --
52
--------------------------------------------------
53
54
with Asis.Elements;
55
with Asis.Clauses;
56
with Asis.Declarations;
57
with Asis.Definitions;
58
with Asis.Statements;
59
with Asis.Expressions;
60
with Asis.Extensions;
61
62
with A4G.Vcheck; use A4G.Vcheck;
63
64
package body A4G.Queries is
65
66
-----------------------
67
-- Local subprograms --
68
-----------------------
69
70
-- Subprograms declared below implement first-depth-level parsing of
71
-- Elements of specific kinds - they return a list of queries needed to
72
-- get all the first-depth-level components of teir argument in
73
-- from-left-to-right order
74
75
function PARSE_Defining_Name
76
(Ada_Defining_Name : in Asis.Element)
77
return Query_Array;
78
79
function PARSE_Association
80
(Ada_Association : in Asis.Element)
81
return Query_Array;
82
83
function PARSE_Clause
84
(Ada_Clause : in Asis.Element)
85
return Query_Array;
86
87
function PARSE_Expression
88
(Ada_Expression : in Asis.Element)
89
return Query_Array;
90
91
function PARSE_Path (Ada_Path : in Asis.Element) return Query_Array;
92
93
function PARSE_Definition
94
(Ada_Definition : in Asis.Element)
95
return Query_Array;
96
97
function PARSE_Declaration
98
(Ada_Declaration : in Asis.Element)
99
return Query_Array;
100
101
function PARSE_Statement
102
(Ada_Statement : in Asis.Element)
103
return Query_Array;
104
105
106
107
function PARSE_Defining_Name
108
(Ada_Defining_Name : in Asis.Element)
109
return Query_Array
110
is
111
begin
112
-- PARSE_Defining_Name deals with every Defining_Name 's Element_Kinds.
113
-- That is to say, it deals with Defining_Name_Kinds :
114
-- Not_A_Defining_Name, -- An unexpected element
115
-- A_Defining_Identifier, -- 3.1
116
-- A_Defining_Character_Literal, -- 3.5.1
117
-- A_Defining_Enumeration_Literal, -- 3.5.1
118
-- A_Defining_Operator_Symbol, -- 6.1
119
-- A_Defining_Expanded_Name.
120
-- 6.1 program_unit_name.defining_identifier
121
case Asis.Elements.Defining_Name_Kind (Ada_Defining_Name) is
122
123
-- Terminal Elements : DO NOTHING !!!!
124
when A_Defining_Identifier |
125
A_Defining_Character_Literal |
126
A_Defining_Enumeration_Literal |
127
A_Defining_Operator_Symbol =>
128
-- Terminal Elements : DO NOTHING !!!!
129
return No_Query;
130
131
when A_Defining_Expanded_Name =>
132
return Query_Array'
133
(1 => (Single_Element_Query,
134
Asis.Declarations.Defining_Prefix'Access),
135
136
2 => (Single_Element_Query,
137
Asis.Declarations.Defining_Selector'Access));
138
139
when Not_A_Defining_Name =>
140
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Defining_Name");
141
end case;
142
end PARSE_Defining_Name;
143
144
function PARSE_Association
145
(Ada_Association : in Asis.Element)
146
return Query_Array
147
is
148
begin
149
case Asis.Elements.Association_Kind (Ada_Association) is
150
when Not_An_Association =>
151
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Association");
152
153
when A_Discriminant_Association =>
154
return Query_Array'
155
(1 => (Element_List_Query,
156
Asis.Expressions.Discriminant_Selector_Names'Access),
157
158
2 => (Single_Element_Query,
159
Asis.Expressions.Discriminant_Expression'Access));
160
161
when A_Record_Component_Association =>
162
return Query_Array'
163
(1 => (Element_List_Query,
164
Asis.Expressions.Record_Component_Choices'Access),
165
166
2 => (Single_Element_Query,
167
Asis.Expressions.Component_Expression'Access));
168
169
when An_Array_Component_Association =>
170
return Query_Array'
171
(1 => (Element_List_Query,
172
Asis.Expressions.Array_Component_Choices'Access),
173
174
2 => (Single_Element_Query,
175
Asis.Expressions.Component_Expression'Access));
176
177
when A_Parameter_Association |
178
A_Pragma_Argument_Association |
179
A_Generic_Association =>
180
return Query_Array'
181
(1 => (Single_Element_Query,
182
Asis.Expressions.Formal_Parameter'Access),
183
184
2 => (Single_Element_Query,
185
Asis.Expressions.Actual_Parameter'Access));
186
187
end case;
188
end PARSE_Association;
189
190
191
function PARSE_Clause
192
(Ada_Clause : in Asis.Element)
193
return Query_Array
194
is
195
begin
196
case Asis.Elements.Clause_Kind (Ada_Clause) is
197
when Not_A_Clause =>
198
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Clause");
199
200
when A_Use_Package_Clause |
201
A_Use_Type_Clause |
202
A_With_Clause =>
203
return Query_Array'
204
(1 => (Element_List_Query, Asis.Clauses.Clause_Names'Access));
205
206
when A_Representation_Clause =>
207
case Asis.Elements.Representation_Clause_Kind (Ada_Clause) is
208
when Not_A_Representation_Clause =>
209
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Clause");
210
211
when An_Attribute_Definition_Clause |
212
An_Enumeration_Representation_Clause |
213
An_At_Clause =>
214
return Query_Array'
215
(1 => (Single_Element_Query,
216
Asis.Clauses.Representation_Clause_Name'Access),
217
218
2 => (Single_Element_Query,
219
Asis.Clauses.Representation_Clause_Expression'Access));
220
221
when A_Record_Representation_Clause =>
222
return Query_Array'
223
(1 => (Single_Element_Query,
224
Asis.Clauses.Representation_Clause_Name'Access),
225
226
2 => (Single_Element_Query,
227
Asis.Clauses.Mod_Clause_Expression'Access),
228
229
3 => (Element_List_Query_With_Boolean,
230
Asis.Clauses.Component_Clauses'Access, True));
231
232
end case;
233
234
when A_Component_Clause =>
235
return Query_Array'
236
(1 => (Single_Element_Query,
237
Asis.Clauses.Representation_Clause_Name'Access),
238
239
2 => (Single_Element_Query,
240
Asis.Clauses.Component_Clause_Position'Access),
241
242
3 => (Single_Element_Query,
243
Asis.Clauses.Component_Clause_Range'Access));
244
245
end case;
246
end PARSE_Clause;
247
248
----------------------------------------------------------------------------
249
-- procedure PARSE_Expression
250
--
251
-- This procedure parse every expressions
252
-- The Expression_Kind are :
253
--
254
-- An_Integer_Literal, -- 2.4
255
-- A_Real_Literal, -- 2.4.1
256
-- A_String_Literal, -- 2.6
257
--
258
-- An_Identifier, -- 4.1
259
-- An_Operator_Symbol, -- 4.1
260
-- A_Character_Literal, -- 4.1
261
-- An_Enumeration_Literal, -- 4.1
262
-- An_Explicit_Dereference, -- 4.1
263
-- A_Function_Call, -- 4.1
264
--
265
-- An_Indexed_Component, -- 4.1.1
266
-- A_Slice, -- 4.1.2
267
-- A_Selected_Component, -- 4.1.3
268
-- An_Attribute_Reference, -- 4.1.4
269
--
270
-- A_Record_Aggregate, -- 4.3
271
-- An_Extension_Aggregate, -- 4.3
272
-- A_Positional_Array_Aggregate, -- 4.3
273
-- A_Named_Array_Aggregate, -- 4.3
274
--
275
-- An_And_Then_Short_Circuit, -- 4.4
276
-- An_Or_Else_Short_Circuit, -- 4.4
277
--
278
-- An_In_Range_Membership_Test, -- 4.4
279
-- A_Not_In_Range_Membership_Test, -- 4.4
280
-- An_In_Type_Membership_Test, -- 4.4
281
-- A_Not_In_Type_Membership_Test, -- 4.4
282
--
283
-- A_Null_Literal, -- 4.4
284
-- A_Parenthesized_Expression, -- 4.4
285
--
286
-- A_Type_Conversion, -- 4.6
287
-- A_Qualified_Expression, -- 4.7
288
--
289
-- An_Allocation_From_Subtype, -- 4.8
290
-- An_Allocation_From_Qualified_Expression, -- 4.8
291
--
292
-- Not_An_Expression. -- An unexpected element
293
--
294
function PARSE_Expression
295
(Ada_Expression : in Asis.Element)
296
return Query_Array
297
is
298
begin
299
-- maybe there could be a factorization of all Prefix processing here
300
case Asis.Elements.Expression_Kind (Ada_Expression) is
301
when Not_An_Expression =>
302
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Expression");
303
304
when An_Integer_Literal |
305
A_Real_Literal |
306
A_String_Literal |
307
An_Identifier |
308
An_Operator_Symbol |
309
A_Character_Literal |
310
An_Enumeration_Literal |
311
A_Null_Literal =>
312
return No_Query;
313
314
when An_Explicit_Dereference =>
315
-- P.ALL
316
return Query_Array'
317
(1 => (Single_Element_Query, Asis.Expressions.Prefix'Access));
318
319
when A_Function_Call =>
320
-- Abc(...) or Integer'Image(...)
321
return Query_Array'
322
(1 => (Single_Element_Query, Asis.Expressions.Prefix'Access),
323
2 => (Element_List_Query_With_Boolean,
324
Asis.Expressions.Function_Call_Parameters'Access, False));
325
326
when An_Indexed_Component =>
327
-- An_Array(3)
328
return Query_Array'
329
(1 => (Single_Element_Query, Asis.Expressions.Prefix'Access),
330
2 => (Element_List_Query,
331
Asis.Expressions.Index_Expressions'Access));
332
333
when A_Slice => -- An_Array(3 .. 5)
334
return Query_Array'
335
(1 => (Single_Element_Query, Asis.Expressions.Prefix'Access),
336
2 => (Single_Element_Query, Asis.Expressions.Slice_Range'Access));
337
338
when A_Selected_Component => -- A.B.C
339
return Query_Array'
340
(1 => (Single_Element_Query, Asis.Expressions.Prefix'Access),
341
2 => (Single_Element_Query, Asis.Expressions.Selector'Access));
342
343
when An_Attribute_Reference => -- Priv'Base'First
344
345
-- Attribute_Designator_Expressions
346
case Asis.Elements.Attribute_Kind (Ada_Expression) is
347
when Not_An_Attribute =>
348
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Expression");
349
350
when A_First_Attribute |
351
A_Last_Attribute |
352
A_Length_Attribute |
353
A_Range_Attribute |
354
An_Implementation_Defined_Attribute |
355
An_Unknown_Attribute =>
356
357
return Query_Array'
358
(1 => (Single_Element_Query,
359
Asis.Expressions.Prefix'Access),
360
361
2 => (Single_Element_Query,
362
Asis.Expressions.Attribute_Designator_Identifier'Access),
363
3 => (Element_List_Query,
364
Asis.Expressions.Attribute_Designator_Expressions'Access));
365
366
when others =>
367
return Query_Array'
368
(1 => (Single_Element_Query,
369
Asis.Expressions.Prefix'Access),
370
2 => (Single_Element_Query,
371
Asis.Expressions.Attribute_Designator_Identifier'Access));
372
end case;
373
374
when A_Record_Aggregate =>
375
-- (Field1 => value1, Field2 => value2)
376
377
return Query_Array'
378
(1 => (Element_List_Query_With_Boolean,
379
Asis.Expressions.Record_Component_Associations'Access, False));
380
381
when An_Extension_Aggregate =>
382
-- (Ewpr with Field1 => value1, Field2 => value2)
383
384
return Query_Array'
385
(1 => (Single_Element_Query,
386
Asis.Expressions.Extension_Aggregate_Expression'Access),
387
388
2 => (Element_List_Query_With_Boolean,
389
Asis.Expressions.Record_Component_Associations'Access, False));
390
391
392
when A_Positional_Array_Aggregate |
393
A_Named_Array_Aggregate =>
394
395
return Query_Array'
396
(1 => (Element_List_Query,
397
Asis.Expressions.Array_Component_Associations'Access));
398
399
when An_And_Then_Short_Circuit |
400
An_Or_Else_Short_Circuit =>
401
402
return Query_Array'
403
(1 => (Single_Element_Query,
404
Asis.Expressions.Short_Circuit_Operation_Left_Expression'Access),
405
406
2 => (Single_Element_Query,
407
Asis.Expressions.Short_Circuit_Operation_Right_Expression'Access));
408
409
when An_In_Range_Membership_Test |
410
A_Not_In_Range_Membership_Test =>
411
412
return Query_Array'
413
(1 => (Single_Element_Query,
414
Asis.Expressions.Membership_Test_Expression'Access),
415
416
2 => (Single_Element_Query,
417
Asis.Expressions.Membership_Test_Range'Access));
418
419
when An_In_Type_Membership_Test |
420
A_Not_In_Type_Membership_Test =>
421
422
return Query_Array'
423
(1 => (Single_Element_Query,
424
Asis.Expressions.Membership_Test_Expression'Access),
425
426
2 => (Single_Element_Query,
427
Asis.Expressions.Membership_Test_Subtype_Mark'Access));
428
429
when A_Parenthesized_Expression =>
430
431
return Query_Array'
432
(1 => (Single_Element_Query,
433
Asis.Expressions.Expression_Parenthesized'Access));
434
435
when A_Type_Conversion |
436
A_Qualified_Expression =>
437
438
return Query_Array'
439
(1 => (Single_Element_Query,
440
Asis.Expressions.Converted_Or_Qualified_Subtype_Mark'Access),
441
2 => (Single_Element_Query,
442
Asis.Expressions.Converted_Or_Qualified_Expression'Access));
443
444
when An_Allocation_From_Subtype =>
445
446
return Query_Array'
447
(1 => (Single_Element_Query,
448
Asis.Expressions.Allocator_Subtype_Indication'Access));
449
450
when An_Allocation_From_Qualified_Expression =>
451
452
return Query_Array'
453
(1 => (Single_Element_Query,
454
Asis.Expressions.Allocator_Qualified_Expression'Access));
455
456
end case;
457
end PARSE_Expression;
458
459
460
-----------------------------------------------------------------------
461
-- PARSE_Path deals with every Path 's Element_Kind.
462
-- That is to say, it deals with Path_Kinds :
463
-- Not_A_Path, -- An unexpected element
464
-- An_If_Path, -- 5.3:
465
-- -- if condition then
466
-- -- sequence_of_statements
467
-- An_Elsif_Path, -- 5.3:
468
-- -- elsif condition then
469
-- -- sequence_of_statements
470
-- An_Else_Path, -- 5.3, 9.7.1, 9.7.3:
471
-- -- else sequence_of_statements
472
-- A_Case_Path, -- 5.4:
473
-- -- when discrete_choice_list =>
474
-- -- sequence_of_statements
475
-- A_Select_Path, -- 9.7.1:
476
-- -- select [guard] select_alternative
477
-- -- 9.7.2, 9.7.3:
478
-- -- select entry_call_alternative
479
-- -- 9.7.4:
480
-- -- select triggering_alternative
481
-- An_Or_Path, -- 9.7.1:
482
-- -- or [guard] select_alternative
483
-- -- 9.7.2:
484
-- -- or delay_alternative
485
-- A_Then_Abort_Path. -- 9.7.4
486
-- -- then abort sequence_of_statements
487
--
488
-- (See asis_element_kind.ads for more details)
489
--
490
function PARSE_Path (Ada_Path : in Asis.Element) return Query_Array is
491
begin
492
case Asis.Elements.Path_Kind (Ada_Path) is
493
when An_If_Path |
494
An_Elsif_Path =>
495
496
return Query_Array'
497
(1 => (Single_Element_Query,
498
Asis.Statements.Condition_Expression'Access),
499
500
2 => (Element_List_Query_With_Boolean,
501
Asis.Statements.Sequence_Of_Statements'Access, True));
502
503
when An_Else_Path |
504
A_Then_Abort_Path =>
505
506
return Query_Array'
507
(1 => (Element_List_Query_With_Boolean,
508
Asis.Statements.Sequence_Of_Statements'Access, True));
509
510
when A_Case_Path =>
511
512
return Query_Array'
513
(1 => (Element_List_Query,
514
Asis.Statements.Case_Statement_Alternative_Choices'Access),
515
516
2 => (Element_List_Query_With_Boolean,
517
Asis.Statements.Sequence_Of_Statements'Access, True));
518
519
when A_Select_Path |
520
An_Or_Path =>
521
522
return Query_Array'
523
(1 => (Single_Element_Query, Asis.Statements.Guard'Access),
524
2 => (Element_List_Query_With_Boolean,
525
Asis.Statements.Sequence_Of_Statements'Access, True));
526
527
when Not_A_Path =>
528
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Path");
529
530
end case;
531
532
end PARSE_Path;
533
534
-----------------------------------------------------------------------
535
-- procedure PARSE_Definition
536
--
537
-- This procedure parse every definitions
538
-- The Definition_Kinds are :
539
--
540
-- Definition_Kinds LRM P.
541
-- SubType_Kind
542
-----------------------------------------------------------------------
543
-- Not_A_Definition, -- An unexpected element
544
--
545
-- A_Type_Definition, -- 3.2.1
546
-- Not_A_Type_Definition, -- An unexpected element
547
-- A_Derived_Type_Definition, -- 3.4
548
-- A_Derived_Record_Extension_Definition, -- 3.4
549
-- An_Enumeration_Type_Definition, -- 3.5.1
550
-- A_Signed_Integer_Type_Definition, -- 3.5.4
551
-- A_Modular_Type_Definition, -- 3.5.4
552
-- A_Root_Type_Definition, -- 3.5.4(10), 3.5.6(4)
553
-- A_Floating_Point_Definition, -- 3.5.7
554
-- An_Ordinary_Fixed_Point_Definition, -- 3.5.9
555
-- A_Decimal_Fixed_Point_Definition, -- 3.5.9
556
-- An_Unconstrained_Array_Definition, -- 3.6
557
-- A_Constrained_Array_Definition, -- 3.6
558
-- A_Record_Type_Definition, -- 3.8
559
-- A_Tagged_Record_Type_Definition, -- 3.8
560
-- An_Access_Type_Definition. -- 3.10
561
-- Not_An_Access_Type_Definition, -- An unexpected element
562
-- A_Pool_Specific_Access_To_Variable, -- access subtype_indication
563
-- An_Access_To_Variable, -- access all subtype_indication
564
-- An_Access_To_Constant, -- access constant subtype_indication
565
-- An_Access_To_Procedure, -- access procedure
566
-- An_Access_To_Protected_Procedure, -- access protected procedure
567
-- An_Access_To_Function, -- access function
568
-- An_Access_To_Protected_Function. -- access protected function
569
--
570
-- A_Subtype_Indication, -- 3.2.2
571
--
572
-- A_Constraint, -- 3.2.2
573
-- Not_A_Constraint, -- An unexpected element
574
-- A_Range_Attribute_Reference, -- 3.2.2, 3.5
575
-- A_Simple_Expression_Range, -- 3.2.2, 3.5
576
-- A_Digits_Constraint, -- 3.2.2, 3.5.9
577
-- A_Delta_Constraint, -- 3.2.2, J.3
578
-- An_Index_Constraint, -- 3.2.2, 3.6.1
579
-- A_Discriminant_Constraint. -- 3.2.2
580
--
581
-- A_Component_Definition, -- 3.6
582
--
583
-- A_Discrete_Subtype_Definition, -- 3.6
584
-- A_Discrete_Range, -- 3.6.1
585
-- Not_A_Discrete_Range, -- An unexpected element
586
-- A_Discrete_Subtype_Indication, -- 3.6.1, 3.2.2
587
-- A_Discrete_Range_Attribute_Reference, -- 3.6.1, 3.5
588
-- A_Discrete_Simple_Expression_Range. -- 3.6.1, 3.5
589
--
590
--
591
-- An_Unknown_Discriminant_Part, -- 3.7
592
-- A_Known_Discriminant_Part, -- 3.7
593
--
594
-- A_Record_Definition, -- 3.8
595
-- A_Null_Record_Definition, -- 3.8
596
--
597
-- A_Null_Component, -- 3.8
598
-- A_Variant_Part, -- 3.8
599
-- A_Variant, -- 3.8
600
--
601
-- An_Others_Choice, -- 3.8.1, 4.3.1, 4.3.3, 11.2
602
--
603
-- A_Private_Type_Definition, -- 7.3
604
-- A_Tagged_Private_Type_Definition, -- 7.3
605
-- A_Private_Extension_Definition, -- 7.3
606
--
607
-- A_Task_Definition, -- 9.1
608
-- A_Protected_Definition, -- 9.4
609
--
610
-- A_Formal_Type_Definition. -- 12.5
611
-- Not_A_Formal_Type_Definition, -- An unexpected element
612
-- A_Formal_Private_Type_Definition, -- 12.5.1
613
-- A_Formal_Tagged_Private_Type_Definition, -- 12.5.1
614
-- A_Formal_Derived_Type_Definition, -- 12.5.1
615
-- A_Formal_Discrete_Type_Definition, -- 12.5.2
616
-- A_Formal_Signed_Integer_Type_Definition, -- 12.5.2
617
-- A_Formal_Modular_Type_Definition, -- 12.5.2
618
-- A_Formal_Floating_Point_Definition, -- 12.5.2
619
-- A_Formal_Ordinary_Fixed_Point_Definition, -- 12.5.2
620
-- A_Formal_Decimal_Fixed_Point_Definition, -- 12.5.2
621
-- A_Formal_Unconstrained_Array_Definition, -- 12.5.3
622
-- A_Formal_Constrained_Array_Definition, -- 12.5.3
623
-- A_Formal_Access_Type_Definition. -- 12.5.4
624
--
625
-----------------------------------------------------------------------
626
627
function PARSE_Definition
628
(Ada_Definition : in Asis.Element)
629
return Query_Array
630
is
631
begin
632
case Asis.Elements.Definition_Kind (Ada_Definition) is
633
when Not_A_Definition =>
634
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Definition");
635
636
-- A_Type_Definition. -- 3.2.1
637
when A_Type_Definition =>
638
case Asis.Elements.Type_Kind (Ada_Definition) is
639
-- Not_A_Type_Definition, -- An unexpected element
640
when Not_A_Type_Definition =>
641
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Definition");
642
643
-- A_Derived_Type_Definition, -- 3.4
644
when A_Derived_Type_Definition =>
645
646
return Query_Array'
647
(1 => (Single_Element_Query,
648
Asis.Definitions.Parent_Subtype_Indication'Access));
649
650
-- A_Derived_Record_Extension_Definition, -- 3.4
651
when A_Derived_Record_Extension_Definition =>
652
653
return Query_Array'
654
(1 => (Single_Element_Query,
655
Asis.Definitions.Parent_Subtype_Indication'Access),
656
657
2 => (Single_Element_Query,
658
Asis.Definitions.Record_Definition'Access));
659
660
-- An_Enumeration_Type_Definition, -- 3.5.1
661
when An_Enumeration_Type_Definition =>
662
663
return Query_Array'
664
(1 => (Element_List_Query,
665
Asis.Definitions.Enumeration_Literal_Declarations'Access));
666
667
-- A_Signed_Integer_Type_Definition, -- 3.5.4
668
when A_Signed_Integer_Type_Definition =>
669
670
return Query_Array'
671
(1 => (Single_Element_Query,
672
Asis.Definitions.Integer_Constraint'Access));
673
674
-- A_Modular_Type_Definition, -- 3.5.4
675
when A_Modular_Type_Definition =>
676
677
return Query_Array'
678
(1 => (Single_Element_Query,
679
Asis.Definitions.Mod_Static_Expression'Access));
680
681
-- A_Root_Type_Definition, -- 3.5.4(10), 3.5.6(4)
682
when A_Root_Type_Definition =>
683
return No_Query;
684
685
-- A_Floating_Point_Definition, -- 3.5.7
686
when A_Floating_Point_Definition =>
687
688
return Query_Array'
689
(1 => (Single_Element_Query,
690
Asis.Definitions.Digits_Expression'Access),
691
692
2 => (Single_Element_Query,
693
Asis.Definitions.Real_Range_Constraint'Access));
694
695
-- An_Ordinary_Fixed_Point_Definition, -- 3.5.9
696
when An_Ordinary_Fixed_Point_Definition =>
697
698
return Query_Array'
699
(1 => (Single_Element_Query,
700
Asis.Definitions.Delta_Expression'Access),
701
702
2 => (Single_Element_Query,
703
Asis.Definitions.Real_Range_Constraint'Access));
704
705
-- A_Decimal_Fixed_Point_Definition, -- 3.5.9
706
when A_Decimal_Fixed_Point_Definition =>
707
708
return Query_Array'
709
(1 => (Single_Element_Query,
710
Asis.Definitions.Delta_Expression'Access),
711
712
2 => (Single_Element_Query,
713
Asis.Definitions.Digits_Expression'Access),
714
715
3 => (Single_Element_Query,
716
Asis.Definitions.Real_Range_Constraint'Access));
717
718
-- An_Unconstrained_Array_Definition, -- 3.6
719
when An_Unconstrained_Array_Definition =>
720
721
return Query_Array'
722
(1 => (Element_List_Query,
723
Asis.Definitions.Index_Subtype_Definitions'Access),
724
725
2 => (Single_Element_Query,
726
Asis.Definitions.Array_Component_Definition'Access));
727
728
-- A_Constrained_Array_Definition, -- 3.6
729
when A_Constrained_Array_Definition =>
730
731
return Query_Array'
732
(1 => (Element_List_Query,
733
Asis.Definitions.Discrete_Subtype_Definitions'Access),
734
735
2 => (Single_Element_Query,
736
Asis.Definitions.Array_Component_Definition'Access));
737
738
-- A_Record_Type_Definition, -- 3.8
739
-- A_Tagged_Record_Type_Definition, -- 3.8
740
when A_Record_Type_Definition |
741
A_Tagged_Record_Type_Definition =>
742
743
return Query_Array'
744
(1 => (Single_Element_Query,
745
Asis.Definitions.Record_Definition'Access));
746
747
-- An_Access_Type_Definition. -- 3.10
748
when An_Access_Type_Definition =>
749
750
case Asis.Elements.Access_Type_Kind (Ada_Definition) is
751
-- Not_An_Access_Type_Definition,
752
when Not_An_Access_Type_Definition =>
753
Raise_ASIS_Failed
754
("Asis.Elements.Queries.PARSE_Definition");
755
756
-- A_Pool_Specific_Access_To_Variable,
757
-- An_Access_To_Variable,
758
-- An_Access_To_Constant,
759
when A_Pool_Specific_Access_To_Variable |
760
An_Access_To_Variable |
761
An_Access_To_Constant =>
762
763
return Query_Array'
764
(1 => (Single_Element_Query,
765
Asis.Definitions.Access_To_Object_Definition'Access));
766
767
-- An_Access_To_Procedure,
768
-- An_Access_To_Protected_Procedure,
769
when An_Access_To_Procedure |
770
An_Access_To_Protected_Procedure =>
771
772
return Query_Array'
773
(1 => (Element_List_Query,
774
Asis.Definitions.Access_To_Subprogram_Parameter_Profile'Access));
775
776
-- An_Access_To_Function,
777
-- An_Access_To_Protected_Function
778
when An_Access_To_Function |
779
An_Access_To_Protected_Function =>
780
781
return Query_Array'
782
(1 => (Element_List_Query,
783
Asis.Definitions.Access_To_Subprogram_Parameter_Profile'Access),
784
785
2 => (Single_Element_Query,
786
Asis.Definitions.Access_To_Function_Result_Profile'Access));
787
788
end case;
789
end case;
790
791
-- A_Subtype_Indication, -- 3.2.2
792
when A_Subtype_Indication =>
793
794
return Query_Array'
795
(1 => (Single_Element_Query,
796
Asis.Definitions.Subtype_Mark'Access),
797
798
2 => (Single_Element_Query,
799
Asis.Definitions.Subtype_Constraint'Access));
800
801
-- A_Constraint, -- 3.2.2
802
when A_Constraint =>
803
case Asis.Elements.Constraint_Kind (Ada_Definition) is
804
-- Not_A_Constraint, -- An unexpected element
805
when Not_A_Constraint =>
806
Raise_ASIS_Failed
807
("Asis.Elements.Queries.PARSE_Definition");
808
809
-- A_Range_Attribute_Reference, -- 3.2.2, 3.5
810
when A_Range_Attribute_Reference =>
811
812
return Query_Array'
813
(1 => (Single_Element_Query,
814
Asis.Definitions.Range_Attribute'Access));
815
816
-- A_Simple_Expression_Range, -- 3.2.2, 3.5
817
when A_Simple_Expression_Range =>
818
819
return Query_Array'
820
(1 => (Single_Element_Query,
821
Asis.Definitions.Lower_Bound'Access),
822
823
2 => (Single_Element_Query,
824
Asis.Definitions.Upper_Bound'Access));
825
826
-- A_Digits_Constraint, -- 3.2.2, 3.5.9
827
when A_Digits_Constraint =>
828
829
return Query_Array'
830
(1 => (Single_Element_Query,
831
Asis.Definitions.Digits_Expression'Access),
832
833
2 => (Single_Element_Query,
834
Asis.Definitions.Real_Range_Constraint'Access));
835
836
-- A_Delta_Constraint, -- 3.2.2, J.3
837
when A_Delta_Constraint =>
838
839
return Query_Array'
840
(1 => (Single_Element_Query,
841
Asis.Definitions.Delta_Expression'Access),
842
843
2 => (Single_Element_Query,
844
Asis.Definitions.Real_Range_Constraint'Access));
845
846
-- An_Index_Constraint, -- 3.2.2, 3.6.1
847
when An_Index_Constraint =>
848
849
return Query_Array'
850
(1 => (Element_List_Query,
851
Asis.Definitions.Discrete_Ranges'Access));
852
853
-- A_Discriminant_Constraint. -- 3.2.2
854
when A_Discriminant_Constraint =>
855
856
return Query_Array'
857
(1 => (Element_List_Query_With_Boolean,
858
Asis.Definitions.Discriminant_Associations'Access, False));
859
end case;
860
861
-- A_Component_Definition, -- 3.6
862
when A_Component_Definition =>
863
864
return Query_Array'
865
(1 => (Single_Element_Query,
866
Asis.Definitions.Component_Subtype_Indication'Access));
867
868
-- A_Discrete_Subtype_Definition, -- 3.6
869
-- A_Discrete_Range, -- 3.6.1
870
when A_Discrete_Subtype_Definition |
871
A_Discrete_Range =>
872
case Asis.Elements.Discrete_Range_Kind (Ada_Definition) is
873
-- Not_A_Discrete_Range, -- An unexpected element
874
when Not_A_Discrete_Range =>
875
Raise_ASIS_Failed
876
("Asis.Elements.Queries.PARSE_Definition");
877
878
-- A_Discrete_Subtype_Indication, -- 3.6.1, 3.2.2
879
when A_Discrete_Subtype_Indication =>
880
881
return Query_Array'
882
(1 => (Single_Element_Query,
883
Asis.Definitions.Subtype_Mark'Access),
884
885
2 => (Single_Element_Query,
886
Asis.Definitions.Subtype_Constraint'Access));
887
888
-- A_Discrete_Range_Attribute_Reference, -- 3.6.1, 3.5
889
when A_Discrete_Range_Attribute_Reference =>
890
891
return Query_Array'
892
(1 => (Single_Element_Query,
893
Asis.Definitions.Range_Attribute'Access));
894
895
-- A_Discrete_Simple_Expression_Range. -- 3.6.1, 3.5
896
when A_Discrete_Simple_Expression_Range =>
897
898
return Query_Array'
899
(1 => (Single_Element_Query,
900
Asis.Definitions.Lower_Bound'Access),
901
902
2 => (Single_Element_Query,
903
Asis.Definitions.Upper_Bound'Access));
904
905
end case;
906
907
-- An_Unknown_Discriminant_Part, -- 3.7
908
when An_Unknown_Discriminant_Part =>
909
return No_Query;
910
911
912
913
-- A_Known_Discriminant_Part, -- 3.7
914
when A_Known_Discriminant_Part =>
915
916
return Query_Array'
917
(1 => (Element_List_Query,
918
Asis.Definitions.Discriminants'Access));
919
920
-- A_Record_Definition, -- 3.8
921
when A_Record_Definition =>
922
923
return Query_Array'
924
(1 => (Element_List_Query_With_Boolean,
925
Asis.Definitions.Record_Components'Access, True));
926
927
-- A_Null_Record_Definition, -- 3.8
928
-- A_Null_Component, -- 3.8
929
when A_Null_Record_Definition |
930
A_Null_Component =>
931
932
return No_Query;
933
934
-- A_Variant_Part, -- 3.8
935
when A_Variant_Part =>
936
937
return Query_Array'
938
(1 => (Single_Element_Query,
939
Asis.Definitions.Discriminant_Direct_Name'Access),
940
941
2 => (Element_List_Query_With_Boolean,
942
Asis.Definitions.Variants'Access, True));
943
944
-- A_Variant, -- 3.8
945
when A_Variant =>
946
947
return Query_Array'
948
(1 => (Element_List_Query,
949
Asis.Definitions.Variant_Choices'Access),
950
951
2 => (Element_List_Query_With_Boolean,
952
Asis.Definitions.Record_Components'Access, True));
953
954
-- An_Others_Choice, -- 3.8.1, 4.3.1, 4.3.3, 11.2
955
when An_Others_Choice =>
956
957
return No_Query;
958
959
-- A_Private_Type_Definition, -- 7.3
960
-- A_Tagged_Private_Type_Definition, -- 7.3
961
when A_Private_Type_Definition |
962
A_Tagged_Private_Type_Definition =>
963
964
return No_Query;
965
966
-- A_Private_Extension_Definition, -- 7.3
967
when A_Private_Extension_Definition =>
968
969
return Query_Array'
970
(1 => (Single_Element_Query,
971
Asis.Definitions.Ancestor_Subtype_Indication'Access));
972
973
-- A_Task_Definition, -- 9.1
974
-- A_Protected_Definition, -- 9.4
975
when A_Task_Definition |
976
A_Protected_Definition =>
977
978
return Query_Array'
979
(1 => (Element_List_Query_With_Boolean,
980
Asis.Definitions.Visible_Part_Items'Access, True),
981
982
2 => (Element_List_Query_With_Boolean,
983
Asis.Definitions.Private_Part_Items'Access, True));
984
985
-- A_Formal_Type_Definition. -- 12.5
986
when A_Formal_Type_Definition =>
987
case Asis.Elements.Formal_Type_Kind (Ada_Definition) is
988
-- Not_A_Formal_Type_Definition, -- An unexpected element
989
when Not_A_Formal_Type_Definition =>
990
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Definition");
991
992
-- A_Formal_Private_Type_Definition, -- 12.5.1
993
-- A_Formal_Tagged_Private_Type_Definition, -- 12.5.1
994
-- A_Formal_Discrete_Type_Definition, -- 12.5.2
995
-- A_Formal_Signed_Integer_Type_Definition, -- 12.5.2
996
-- A_Formal_Modular_Type_Definition, -- 12.5.2
997
-- A_Formal_Floating_Point_Definition, -- 12.5.2
998
-- A_Formal_Ordinary_Fixed_Point_Definition, -- 12.5.2
999
-- A_Formal_Decimal_Fixed_Point_Definition, -- 12.5.2
1000
when A_Formal_Private_Type_Definition |
1001
A_Formal_Tagged_Private_Type_Definition |
1002
A_Formal_Discrete_Type_Definition |
1003
A_Formal_Signed_Integer_Type_Definition |
1004
A_Formal_Modular_Type_Definition |
1005
A_Formal_Floating_Point_Definition |
1006
A_Formal_Ordinary_Fixed_Point_Definition |
1007
A_Formal_Decimal_Fixed_Point_Definition =>
1008
1009
return No_Query;
1010
1011
-- A_Formal_Derived_Type_Definition, -- 12.5.1
1012
when A_Formal_Derived_Type_Definition =>
1013
return Query_Array'
1014
(1 => (Single_Element_Query,
1015
Asis.Definitions.Subtype_Mark'Access));
1016
1017
-- A_Formal_Unconstrained_Array_Definition, -- 12.5.3
1018
when A_Formal_Unconstrained_Array_Definition =>
1019
1020
return Query_Array'
1021
(1 => (Element_List_Query,
1022
Asis.Definitions.Index_Subtype_Definitions'Access),
1023
1024
2 => (Single_Element_Query,
1025
Asis.Definitions.Array_Component_Definition'Access));
1026
1027
-- A_Formal_Constrained_Array_Definition, -- 12.5.3
1028
when A_Formal_Constrained_Array_Definition =>
1029
1030
return Query_Array'
1031
(1 => (Element_List_Query,
1032
Asis.Definitions.Discrete_Subtype_Definitions'Access),
1033
1034
2 => (Single_Element_Query,
1035
Asis.Definitions.Array_Component_Definition'Access));
1036
1037
-- A_Formal_Access_Type_Definition. -- 12.5.4
1038
when A_Formal_Access_Type_Definition =>
1039
1040
case Asis.Elements.Access_Type_Kind (Ada_Definition) is
1041
-- Not_An_Access_Type_Definition,
1042
when Not_An_Access_Type_Definition =>
1043
Raise_ASIS_Failed
1044
("Asis.Elements.Queries.PARSE_Definition");
1045
1046
-- A_Pool_Specific_Access_To_Variable,
1047
-- An_Access_To_Variable,
1048
-- An_Access_To_Constant,
1049
when A_Pool_Specific_Access_To_Variable |
1050
An_Access_To_Variable |
1051
An_Access_To_Constant =>
1052
1053
return Query_Array'
1054
(1 => (Single_Element_Query,
1055
Asis.Definitions.Access_To_Object_Definition'Access));
1056
1057
-- An_Access_To_Procedure,
1058
-- An_Access_To_Protected_Procedure,
1059
when An_Access_To_Procedure |
1060
An_Access_To_Protected_Procedure =>
1061
1062
return Query_Array'
1063
(1 => (Element_List_Query,
1064
Asis.Definitions.Access_To_Subprogram_Parameter_Profile'Access));
1065
1066
-- An_Access_To_Function,
1067
-- An_Access_To_Protected_Function
1068
when An_Access_To_Function |
1069
An_Access_To_Protected_Function =>
1070
1071
return Query_Array'
1072
(1 => (Element_List_Query,
1073
Asis.Definitions.Access_To_Subprogram_Parameter_Profile'Access),
1074
1075
2 => (Single_Element_Query,
1076
Asis.Definitions.Access_To_Function_Result_Profile'Access));
1077
end case;
1078
end case;
1079
end case;
1080
end PARSE_Definition;
1081
1082
----------------------------------------------------------------------------
1083
-- procedure PARSE_Declaration
1084
--
1085
-- This procedure parse every declarations
1086
-- The Declaration_Kinds are :
1087
--
1088
-- Declaration_Kind LRM P.
1089
----------------------------------------------------------
1090
--
1091
-- An_Ordinary_Type_Declaration, -- 3.2.1
1092
-- A_Task_Type_Declaration, -- 3.2.1
1093
-- A_Protected_Type_Declaration, -- 3.2.1
1094
-- An_Incomplete_Type_Declaration, -- 3.2.1
1095
-- A_Private_Type_Declaration, -- 3.2.1
1096
-- A_Private_Extension_Declaration, -- 3.2.1
1097
--
1098
-- A_Subtype_Declaration, -- 3.2.2
1099
--
1100
-- A_Variable_Declaration, -- 3.3.1
1101
-- A_Constant_Declaration, -- 3.3.1
1102
-- A_Deferred_Constant_Declaration, -- 3.3.1
1103
-- A_Single_Task_Declaration, -- 3.3.1
1104
-- A_Single_Protected_Declaration, -- 3.3.1
1105
--
1106
-- An_Integer_Number_Declaration, -- 3.3.2
1107
-- A_Real_Number_Declaration, -- 3.3.2
1108
--
1109
-- An_Enumeration_Literal_Specification, -- 3.5.1
1110
--
1111
-- A_Discriminant_Specification, -- 3.7
1112
--
1113
-- A_Component_Declaration, -- 3.8
1114
--
1115
-- A_Loop_Parameter_Specification, -- 5.5
1116
--
1117
-- A_Procedure_Declaration, -- 6.1
1118
-- A_Function_Declaration, -- 6.1
1119
--
1120
-- A_Parameter_Specification, -- 6.1
1121
--
1122
-- A_Procedure_Body_Declaration, -- 6.3
1123
-- A_Function_Body_Declaration, -- 6.3
1124
--
1125
-- A_Package_Declaration, -- 7.1
1126
-- A_Package_Body_Declaration, -- 7.2
1127
--
1128
-- An_Object_Renaming_Declaration, -- 8.5.1
1129
-- An_Exception_Renaming_Declaration, -- 8.5.2
1130
-- A_Package_Renaming_Declaration, -- 8.5.3
1131
-- A_Procedure_Renaming_Declaration, -- 8.5.4
1132
-- A_Function_Renaming_Declaration, -- 8.5.4
1133
-- A_Generic_Package_Renaming_Declaration, -- 8.5.5
1134
-- A_Generic_Procedure_Renaming_Declaration, -- 8.5.5
1135
-- A_Generic_Function_Renaming_Declaration, -- 8.5.5
1136
--
1137
-- A_Task_Body_Declaration, -- 9.1
1138
-- A_Protected_Body_Declaration, -- 9.4
1139
--
1140
-- An_Entry_Declaration, -- 9.5.2
1141
-- An_Entry_Body_Declaration, -- 9.5.2
1142
-- An_Entry_Index_Specification, -- 9.5.2
1143
--
1144
-- A_Procedure_Body_Stub, -- 10.1.3
1145
-- A_Function_Body_Stub, -- 10.1.3
1146
-- A_Package_Body_Stub, -- 10.1.3
1147
-- A_Task_Body_Stub, -- 10.1.3
1148
-- A_Protected_Body_Stub, -- 10.1.3
1149
--
1150
-- An_Exception_Declaration, -- 11.1
1151
-- A_Choice_Parameter_Specification, -- 11.2
1152
--
1153
-- A_Generic_Procedure_Declaration, -- 12.1
1154
-- A_Generic_Function_Declaration, -- 12.1
1155
-- A_Generic_Package_Declaration, -- 12.1
1156
--
1157
-- A_Package_Instantiation, -- 12.3
1158
-- A_Procedure_Instantiation, -- 12.3
1159
-- A_Function_Instantiation, -- 12.3
1160
--
1161
-- A_Formal_Object_Declaration, -- 12.4
1162
-- A_Formal_Type_Declaration, -- 12.5
1163
-- A_Formal_Procedure_Declaration, -- 12.6
1164
-- A_Formal_Function_Declaration, -- 12.6
1165
-- A_Formal_Package_Declaration, -- 12.7
1166
-- A_Formal_Package_Declaration_With_Box, -- 12.7
1167
--
1168
-- Not_A_Declaration. -- An unexpected element
1169
----------------------------------------------------------------------------
1170
1171
function PARSE_Declaration
1172
(Ada_Declaration : in Asis.Element)
1173
return Query_Array
1174
is
1175
begin
1176
case Asis.Elements.Declaration_Kind (Ada_Declaration) is
1177
1178
-- An_Ordinary_Type_Declaration, -- 3.2.1
1179
-- A_Protected_Type_Declaration, -- 3.2.1
1180
-- A_Formal_Type_Declaration, -- 12.5
1181
when An_Ordinary_Type_Declaration |
1182
A_Protected_Type_Declaration |
1183
A_Formal_Type_Declaration =>
1184
1185
return Query_Array'
1186
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1187
1188
2 => (Single_Element_Query,
1189
Asis.Declarations.Discriminant_Part'Access),
1190
3 => (Single_Element_Query,
1191
Asis.Declarations.Type_Declaration_View'Access));
1192
1193
-- A_Task_Type_Declaration, -- 3.2.1
1194
-- A_Private_Type_Declaration, -- 3.2.1
1195
-- A_Private_Extension_Declaration, -- 3.2.1
1196
when A_Task_Type_Declaration |
1197
A_Private_Type_Declaration |
1198
A_Private_Extension_Declaration =>
1199
return Query_Array'
1200
1201
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1202
1203
2 => (Single_Element_Query,
1204
Asis.Declarations.Discriminant_Part'Access),
1205
1206
3 => (Single_Element_Query,
1207
Asis.Declarations.Type_Declaration_View'Access));
1208
1209
-- An_Incomplete_Type_Declaration, -- 3.2.1
1210
when An_Incomplete_Type_Declaration =>
1211
1212
return Query_Array'
1213
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1214
1215
2 => (Single_Element_Query,
1216
Asis.Declarations.Discriminant_Part'Access));
1217
1218
-- A_Variable_Declaration, -- 3.3.1
1219
-- A_Constant_Declaration, -- 3.3.1
1220
when A_Variable_Declaration |
1221
A_Constant_Declaration =>
1222
1223
return Query_Array'
1224
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1225
1226
2 => (Single_Element_Query,
1227
Asis.Declarations.Object_Declaration_View'Access),
1228
1229
3 => (Single_Element_Query,
1230
Asis.Declarations.Initialization_Expression'Access));
1231
1232
-- A_Deferred_Constant_Declaration, -- 3.3.1
1233
-- A_Single_Task_Declaration, -- 3.3.1
1234
-- A_Single_Protected_Declaration. -- 3.3.1
1235
when A_Deferred_Constant_Declaration |
1236
A_Single_Task_Declaration |
1237
A_Single_Protected_Declaration =>
1238
1239
return Query_Array'
1240
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1241
1242
2 => (Single_Element_Query,
1243
Asis.Declarations.Object_Declaration_View'Access));
1244
1245
-- An_Integer_Number_Declaration, -- 3.3.2
1246
-- A_Real_Number_Declaration, -- 3.3.2
1247
when An_Integer_Number_Declaration |
1248
A_Real_Number_Declaration =>
1249
1250
return Query_Array'
1251
(1 => (Element_List_Query,
1252
Asis.Declarations.Names'Access),
1253
1254
2 => (Single_Element_Query,
1255
Asis.Declarations.Initialization_Expression'Access));
1256
1257
-- A_Procedure_Declaration, -- 6.1
1258
-- A_Procedure_Body_Stub, -- 10.1.3
1259
when A_Procedure_Declaration |
1260
A_Procedure_Body_Stub =>
1261
return Query_Array'
1262
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1263
1264
2 => (Element_List_Query,
1265
Asis.Declarations.Parameter_Profile'Access));
1266
1267
-- A_Function_Declaration, -- 6.1
1268
-- A_Function_Body_Stub, -- 10.1.3
1269
when A_Function_Declaration |
1270
A_Function_Body_Stub =>
1271
1272
return Query_Array'
1273
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1274
1275
2 => (Element_List_Query,
1276
Asis.Declarations.Parameter_Profile'Access),
1277
1278
3 => (Single_Element_Query,
1279
Asis.Declarations.Result_Profile'Access));
1280
1281
-- A_Package_Declaration, -- 7.1
1282
when A_Package_Declaration =>
1283
1284
return Query_Array'
1285
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1286
1287
2 => (Element_List_Query_With_Boolean,
1288
Asis.Declarations.Visible_Part_Declarative_Items'Access, True),
1289
1290
3 => (Element_List_Query_With_Boolean,
1291
Asis.Declarations.Private_Part_Declarative_Items'Access, True));
1292
1293
-- An_Entry_Declaration, -- 9.5.2
1294
when An_Entry_Declaration =>
1295
1296
return Query_Array'
1297
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1298
1299
2 => (Single_Element_Query,
1300
Asis.Declarations.Entry_Family_Definition'Access),
1301
1302
3 => (Element_List_Query,
1303
Asis.Declarations.Parameter_Profile'Access));
1304
1305
-- A_Package_Body_Stub, -- 10.1.3
1306
-- A_Task_Body_Stub, -- 10.1.3
1307
-- A_Protected_Body_Stub, -- 10.1.3
1308
-- An_Exception_Declaration, -- 11.1
1309
when A_Package_Body_Stub |
1310
A_Task_Body_Stub |
1311
A_Protected_Body_Stub |
1312
An_Exception_Declaration =>
1313
1314
return Query_Array'
1315
(1 => (Element_List_Query, Asis.Declarations.Names'Access));
1316
1317
-- A_Generic_Procedure_Declaration, -- 12.1
1318
when A_Generic_Procedure_Declaration =>
1319
1320
return Query_Array'
1321
(1 => (Element_List_Query_With_Boolean,
1322
Asis.Declarations.Generic_Formal_Part'Access, True),
1323
1324
2 => (Element_List_Query, Asis.Declarations.Names'Access),
1325
1326
3 => (Element_List_Query,
1327
Asis.Declarations.Parameter_Profile'Access));
1328
1329
1330
-- A_Generic_Function_Declaration, -- 12.1
1331
when A_Generic_Function_Declaration =>
1332
1333
return Query_Array'
1334
(1 => (Element_List_Query_With_Boolean,
1335
Asis.Declarations.Generic_Formal_Part'Access, True),
1336
1337
2 => (Element_List_Query,
1338
Asis.Declarations.Names'Access),
1339
1340
3 => (Element_List_Query,
1341
Asis.Declarations.Parameter_Profile'Access),
1342
1343
4 => (Single_Element_Query,
1344
Asis.Declarations.Result_Profile'Access));
1345
1346
-- A_Generic_Package_Declaration. -- 12.1
1347
when A_Generic_Package_Declaration =>
1348
1349
return Query_Array'
1350
(1 => (Element_List_Query_With_Boolean,
1351
Asis.Declarations.Generic_Formal_Part'Access, True),
1352
1353
2 => (Element_List_Query,
1354
Asis.Declarations.Names'Access),
1355
1356
3 => (Element_List_Query_With_Boolean,
1357
Asis.Declarations.Visible_Part_Declarative_Items'Access,
1358
True),
1359
1360
4 => (Element_List_Query_With_Boolean,
1361
Asis.Declarations.Private_Part_Declarative_Items'Access,
1362
True));
1363
1364
-- A_Procedure_Body_Declaration, -- 6.3
1365
when A_Procedure_Body_Declaration =>
1366
1367
return Query_Array'
1368
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1369
1370
2 => (Element_List_Query,
1371
Asis.Declarations.Parameter_Profile'Access),
1372
1373
3 => (Element_List_Query_With_Boolean,
1374
Asis.Declarations.Body_Declarative_Items'Access,
1375
True),
1376
1377
4 => (Element_List_Query_With_Boolean,
1378
Asis.Declarations.Body_Statements'Access,
1379
True),
1380
1381
5 => (Element_List_Query_With_Boolean,
1382
Asis.Declarations.Body_Exception_Handlers'Access,
1383
True));
1384
1385
-- A_Function_Body_Declaration, -- 6.3
1386
when A_Function_Body_Declaration =>
1387
1388
return Query_Array'
1389
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1390
1391
2 => (Element_List_Query,
1392
Asis.Declarations.Parameter_Profile'Access),
1393
1394
3 => (Single_Element_Query,
1395
Asis.Declarations.Result_Profile'Access),
1396
1397
4 => (Element_List_Query_With_Boolean,
1398
Asis.Declarations.Body_Declarative_Items'Access,
1399
True),
1400
1401
5 => (Element_List_Query_With_Boolean,
1402
Asis.Declarations.Body_Statements'Access,
1403
True),
1404
1405
6 => (Element_List_Query_With_Boolean,
1406
Asis.Declarations.Body_Exception_Handlers'Access,
1407
True));
1408
1409
-- A_Package_Body_Declaration, -- 7.2
1410
when A_Package_Body_Declaration =>
1411
1412
return Query_Array'
1413
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1414
1415
2 => (Element_List_Query_With_Boolean,
1416
Asis.Declarations.Body_Declarative_Items'Access,
1417
True),
1418
1419
3 => (Element_List_Query_With_Boolean,
1420
Asis.Declarations.Body_Statements'Access,
1421
True),
1422
1423
4 => (Element_List_Query_With_Boolean,
1424
Asis.Declarations.Body_Exception_Handlers'Access,
1425
True));
1426
1427
-- A_Task_Body_Declaration, -- 9.1
1428
when A_Task_Body_Declaration =>
1429
return Query_Array'
1430
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1431
1432
2 => (Element_List_Query_With_Boolean,
1433
Asis.Declarations.Body_Declarative_Items'Access,
1434
True),
1435
1436
3 => (Element_List_Query_With_Boolean,
1437
Asis.Declarations.Body_Statements'Access, True),
1438
1439
4 => (Element_List_Query_With_Boolean,
1440
Asis.Declarations.Body_Exception_Handlers'Access,
1441
True));
1442
1443
-- An_Entry_Body_Declaration, -- 9.5.2
1444
when An_Entry_Body_Declaration =>
1445
1446
return Query_Array'
1447
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1448
1449
2 => (Single_Element_Query,
1450
Asis.Declarations.Entry_Index_Specification'Access),
1451
1452
3 => (Element_List_Query,
1453
Asis.Declarations.Parameter_Profile'Access),
1454
1455
4 => (Single_Element_Query,
1456
Asis.Declarations.Entry_Barrier'Access),
1457
1458
5 => (Element_List_Query_With_Boolean,
1459
Asis.Declarations.Body_Declarative_Items'Access,
1460
True),
1461
1462
6 => (Element_List_Query_With_Boolean,
1463
Asis.Declarations.Body_Statements'Access,
1464
True),
1465
1466
7 => (Element_List_Query_With_Boolean,
1467
Asis.Declarations.Body_Exception_Handlers'Access,
1468
True));
1469
1470
-- A_Protected_Body_Declaration, -- 9.4
1471
when A_Protected_Body_Declaration =>
1472
1473
return Query_Array'
1474
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1475
2 => (Element_List_Query_With_Boolean,
1476
Asis.Declarations.Protected_Operation_Items'Access,
1477
True));
1478
1479
-- An_Object_Renaming_Declaration, -- 8.5.1
1480
when An_Object_Renaming_Declaration =>
1481
1482
return Query_Array'
1483
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1484
1485
2 => (Single_Element_Query,
1486
Asis.Declarations.Declaration_Subtype_Mark'Access),
1487
1488
3 => (Single_Element_Query,
1489
Asis.Declarations.Renamed_Entity'Access));
1490
1491
-- An_Exception_Renaming_Declaration, -- 8.5.2
1492
-- A_Package_Renaming_Declaration, -- 8.5.3
1493
-- A_Generic_Package_Renaming_Declaration, -- 8.5.5
1494
-- A_Generic_Procedure_Renaming_Declaration, -- 8.5.5
1495
-- A_Generic_Function_Renaming_Declaration. -- 8.5.5
1496
when An_Exception_Renaming_Declaration |
1497
A_Package_Renaming_Declaration |
1498
A_Generic_Package_Renaming_Declaration |
1499
A_Generic_Procedure_Renaming_Declaration |
1500
A_Generic_Function_Renaming_Declaration =>
1501
1502
return Query_Array'
1503
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1504
1505
2 => (Single_Element_Query,
1506
Asis.Declarations.Renamed_Entity'Access));
1507
1508
-- A_Procedure_Renaming_Declaration, -- 8.5.4
1509
when A_Procedure_Renaming_Declaration =>
1510
return Query_Array'
1511
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1512
1513
2 => (Element_List_Query,
1514
Asis.Declarations.Parameter_Profile'Access),
1515
1516
3 => (Single_Element_Query,
1517
Asis.Declarations.Renamed_Entity'Access));
1518
1519
-- A_Function_Renaming_Declaration, -- 8.5.4
1520
when A_Function_Renaming_Declaration =>
1521
return Query_Array'
1522
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1523
1524
2 => (Element_List_Query,
1525
Asis.Declarations.Parameter_Profile'Access),
1526
1527
3 => (Single_Element_Query,
1528
Asis.Declarations.Result_Profile'Access),
1529
1530
4 => (Single_Element_Query,
1531
Asis.Declarations.Renamed_Entity'Access));
1532
1533
-- A_Package_Instantiation, -- 12.3
1534
-- A_Procedure_Instantiation, -- 12.3
1535
-- A_Function_Instantiation, -- 12.3
1536
-- A_Formal_Package_Declaration. -- 12.3
1537
when A_Package_Instantiation |
1538
A_Procedure_Instantiation |
1539
A_Function_Instantiation |
1540
A_Formal_Package_Declaration =>
1541
1542
return Query_Array'
1543
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1544
1545
2 => (Single_Element_Query,
1546
Asis.Declarations.Generic_Unit_Name'Access),
1547
1548
3 => (Element_List_Query_With_Boolean,
1549
Asis.Declarations.Generic_Actual_Part'Access,
1550
False)
1551
-- Will Parse the Actual_Part in the UN-Normalized Form.
1552
-- (as noticed in the Traverse_Element specification
1553
-- (see asisi_elements.ads))
1554
);
1555
1556
-- A_Subtype_Declaration, -- 3.2.2
1557
when A_Subtype_Declaration =>
1558
1559
return Query_Array'
1560
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1561
2 => (Single_Element_Query,
1562
Asis.Declarations.Type_Declaration_View'Access));
1563
1564
-- An_Enumeration_Literal_Specification, -- 3.5.1
1565
when An_Enumeration_Literal_Specification =>
1566
1567
return Query_Array'
1568
(1 => (Element_List_Query, Asis.Declarations.Names'Access));
1569
1570
-- A_Discriminant_Specification, -- 3.7 -> Trait_Kinds
1571
-- A_Parameter_Specification, -- 6.1 -> Trait_Kinds
1572
when A_Discriminant_Specification |
1573
A_Parameter_Specification =>
1574
1575
return Query_Array'
1576
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1577
1578
2 => (Single_Element_Query,
1579
Asis.Declarations.Declaration_Subtype_Mark'Access),
1580
1581
3 => (Single_Element_Query,
1582
Asis.Declarations.Initialization_Expression'Access));
1583
1584
-- A_Component_Declaration, -- 3.8
1585
when A_Component_Declaration =>
1586
1587
return Query_Array'
1588
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1589
1590
2 => (Single_Element_Query,
1591
Asis.Declarations.Object_Declaration_View'Access),
1592
1593
3 => (Single_Element_Query,
1594
Asis.Declarations.Initialization_Expression'Access));
1595
1596
-- A_Loop_Parameter_Specification, -- 5.5 -> Trait_Kinds
1597
-- An_Entry_Index_Specification, -- 9.5.2
1598
when A_Loop_Parameter_Specification |
1599
An_Entry_Index_Specification =>
1600
1601
return Query_Array'
1602
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1603
1604
2 => (Single_Element_Query,
1605
Asis.Declarations.Specification_Subtype_Definition'Access));
1606
1607
-- A_Choice_Parameter_Specification, -- 11.2
1608
when A_Choice_Parameter_Specification =>
1609
1610
return Query_Array'
1611
(1 => (Element_List_Query, Asis.Declarations.Names'Access));
1612
1613
-- A_Formal_Object_Declaration, -- 12.4 -> Mode_Kinds
1614
when A_Formal_Object_Declaration =>
1615
return Query_Array'
1616
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1617
1618
2 => (Single_Element_Query,
1619
Asis.Declarations.Declaration_Subtype_Mark'Access),
1620
1621
3 => (Single_Element_Query,
1622
Asis.Declarations.Initialization_Expression'Access));
1623
1624
-- A_Formal_Procedure_Declaration, -- 12.6 -> Default_Kinds
1625
when A_Formal_Procedure_Declaration =>
1626
1627
return Query_Array'
1628
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1629
1630
2 => (Element_List_Query,
1631
Asis.Declarations.Parameter_Profile'Access),
1632
1633
3 => (Single_Element_Query,
1634
Asis.Extensions.Formal_Subprogram_Default'Access)
1635
-- Asis.Declarations.Formal_Subprogram_Default
1636
-- cannot be used here!
1637
);
1638
1639
-- A_Formal_Function_Declaration, -- 12.6 -> Default_Kinds
1640
when A_Formal_Function_Declaration =>
1641
1642
return Query_Array'
1643
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1644
1645
2 => (Element_List_Query,
1646
Asis.Declarations.Parameter_Profile'Access),
1647
1648
3 => (Single_Element_Query,
1649
Asis.Declarations.Result_Profile'Access),
1650
1651
4 => (Single_Element_Query,
1652
Asis.Extensions.Formal_Subprogram_Default'Access)
1653
-- Asis.Declarations.Formal_Subprogram_Default
1654
-- cannot be used here!
1655
);
1656
1657
-- A_Formal_Package_Declaration_With_Box -- 12.7
1658
when A_Formal_Package_Declaration_With_Box =>
1659
1660
return Query_Array'
1661
(1 => (Element_List_Query, Asis.Declarations.Names'Access),
1662
1663
2 => (Single_Element_Query,
1664
Asis.Declarations.Generic_Unit_Name'Access));
1665
1666
-- Not_A_Declaration, -- An unexpected element
1667
when Not_A_Declaration =>
1668
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Declaration");
1669
end case;
1670
1671
end PARSE_Declaration;
1672
1673
function PARSE_Statement
1674
(Ada_Statement : in Asis.Element)
1675
return Query_Array
1676
is
1677
begin
1678
-- all statements can have one or several Labels
1679
case Asis.Elements.Statement_Kind (Ada_Statement) is
1680
when Not_A_Statement =>
1681
Raise_ASIS_Failed ("Asis.Elements.Queries.PARSE_Statement");
1682
1683
when A_Null_Statement =>
1684
1685
return Query_Array'
1686
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access));
1687
1688
when An_Assignment_Statement =>
1689
1690
return Query_Array'
1691
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1692
1693
2 => (Single_Element_Query,
1694
Asis.Statements.Assignment_Variable_Name'Access),
1695
1696
3 => (Single_Element_Query,
1697
Asis.Statements.Assignment_Expression'Access));
1698
1699
when An_If_Statement |
1700
A_Selective_Accept_Statement |
1701
A_Timed_Entry_Call_Statement |
1702
A_Conditional_Entry_Call_Statement |
1703
An_Asynchronous_Select_Statement =>
1704
1705
return Query_Array'
1706
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1707
2 => (Element_List_Query_With_Boolean,
1708
Asis.Statements.Statement_Paths'Access,
1709
True));
1710
1711
when A_Case_Statement =>
1712
1713
return Query_Array'
1714
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1715
1716
2 => (Single_Element_Query,
1717
Asis.Statements.Case_Expression'Access),
1718
1719
3 => (Element_List_Query_With_Boolean,
1720
Asis.Statements.Statement_Paths'Access,
1721
True));
1722
1723
when A_Loop_Statement =>
1724
1725
return Query_Array'
1726
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1727
1728
2 => (Single_Element_Query,
1729
Asis.Statements.Statement_Identifier'Access),
1730
1731
3 => (Element_List_Query_With_Boolean,
1732
Asis.Statements.Loop_Statements'Access,
1733
True));
1734
1735
when A_While_Loop_Statement =>
1736
1737
return Query_Array'
1738
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1739
1740
2 => (Single_Element_Query,
1741
Asis.Statements.Statement_Identifier'Access),
1742
1743
3 => (Single_Element_Query,
1744
Asis.Statements.While_Condition'Access),
1745
1746
4 => (Element_List_Query_With_Boolean,
1747
Asis.Statements.Loop_Statements'Access,
1748
True));
1749
1750
when A_For_Loop_Statement =>
1751
1752
return Query_Array'
1753
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1754
1755
2 => (Single_Element_Query,
1756
Asis.Statements.Statement_Identifier'Access),
1757
1758
3 => (Single_Element_Query,
1759
Asis.Statements.For_Loop_Parameter_Specification'Access),
1760
1761
4 => (Element_List_Query_With_Boolean,
1762
Asis.Statements.Loop_Statements'Access,
1763
True));
1764
1765
when A_Block_Statement =>
1766
1767
return Query_Array'
1768
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1769
1770
2 => (Single_Element_Query,
1771
Asis.Statements.Statement_Identifier'Access),
1772
1773
3 => (Element_List_Query_With_Boolean,
1774
Asis.Statements.Block_Declarative_Items'Access,
1775
True),
1776
1777
4 => (Element_List_Query_With_Boolean,
1778
Asis.Statements.Block_Statements'Access,
1779
True),
1780
1781
5 => (Element_List_Query_With_Boolean,
1782
Asis.Statements.Block_Exception_Handlers'Access,
1783
True));
1784
1785
when An_Exit_Statement =>
1786
1787
return Query_Array'
1788
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1789
1790
2 => (Single_Element_Query,
1791
Asis.Statements.Exit_Loop_Name'Access),
1792
1793
3 => (Single_Element_Query,
1794
Asis.Statements.Exit_Condition'Access));
1795
1796
when A_Goto_Statement =>
1797
1798
return Query_Array'
1799
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1800
2 => (Single_Element_Query, Asis.Statements.Goto_Label'Access));
1801
1802
when A_Procedure_Call_Statement |
1803
An_Entry_Call_Statement =>
1804
1805
return Query_Array'
1806
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1807
2 => (Single_Element_Query, Asis.Statements.Called_Name'Access),
1808
1809
3 => (Element_List_Query_With_Boolean,
1810
Asis.Statements.Call_Statement_Parameters'Access,
1811
False));
1812
1813
when A_Return_Statement =>
1814
1815
return Query_Array'
1816
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1817
1818
2 => (Single_Element_Query,
1819
Asis.Statements.Return_Expression'Access));
1820
1821
when An_Accept_Statement =>
1822
1823
return Query_Array'
1824
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1825
1826
2 => (Single_Element_Query,
1827
Asis.Statements.Accept_Entry_Direct_Name'Access),
1828
1829
3 => (Single_Element_Query,
1830
Asis.Statements.Accept_Entry_Index'Access),
1831
1832
4 => (Element_List_Query,
1833
Asis.Statements.Accept_Parameters'Access),
1834
1835
5 => (Element_List_Query_With_Boolean,
1836
Asis.Statements.Accept_Body_Statements'Access, True),
1837
1838
6 => (Element_List_Query_With_Boolean,
1839
Asis.Statements.Accept_Body_Exception_Handlers'Access,
1840
True));
1841
1842
when A_Requeue_Statement |
1843
A_Requeue_Statement_With_Abort =>
1844
1845
return Query_Array'
1846
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1847
1848
2 => (Single_Element_Query,
1849
Asis.Statements.Requeue_Entry_Name'Access));
1850
1851
when A_Delay_Until_Statement |
1852
A_Delay_Relative_Statement =>
1853
1854
return Query_Array'
1855
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1856
1857
2 => (Single_Element_Query,
1858
Asis.Statements.Delay_Expression'Access));
1859
1860
when A_Terminate_Alternative_Statement =>
1861
1862
return No_Query;
1863
1864
when An_Abort_Statement =>
1865
1866
return Query_Array'
1867
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1868
1869
2 => (Element_List_Query,
1870
Asis.Statements.Aborted_Tasks'Access));
1871
1872
when A_Raise_Statement =>
1873
1874
return Query_Array'
1875
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1876
1877
2 => (Single_Element_Query,
1878
Asis.Statements.Raised_Exception'Access));
1879
1880
when A_Code_Statement =>
1881
1882
return Query_Array'
1883
(1 => (Element_List_Query, Asis.Statements.Label_Names'Access),
1884
1885
2 => (Single_Element_Query,
1886
Asis.Statements.Qualified_Expression'Access));
1887
1888
end case;
1889
1890
end PARSE_Statement;
1891
1892
-- We've separated the functions to make the program clearer,
1893
-- but it is better to expand them inline ...
1894
pragma Inline (PARSE_Defining_Name);
1895
pragma Inline (PARSE_Declaration);
1896
pragma Inline (PARSE_Definition);
1897
pragma Inline (PARSE_Expression);
1898
pragma Inline (PARSE_Association);
1899
pragma Inline (PARSE_Statement);
1900
pragma Inline (PARSE_Path);
1901
pragma Inline (PARSE_Clause);
1902
1903
function Appropriate_Queries (Element : Asis.Element) return Query_Array is
1904
begin
1905
case Asis.Elements.Element_Kind (Element) is
1906
when Not_An_Element =>
1907
return No_Query;
1908
1909
when A_Pragma =>
1910
1911
return Query_Array'
1912
(1 => (Element_List_Query,
1913
Asis.Elements.Pragma_Argument_Associations'Access));
1914
1915
when A_Defining_Name =>
1916
1917
return PARSE_Defining_Name (Element);
1918
1919
when A_Declaration =>
1920
1921
return PARSE_Declaration (Element);
1922
1923
when A_Definition =>
1924
1925
return PARSE_Definition (Element);
1926
1927
when An_Expression =>
1928
1929
return PARSE_Expression (Element);
1930
1931
when An_Association =>
1932
1933
return PARSE_Association (Element);
1934
1935
when A_Statement =>
1936
1937
return PARSE_Statement (Element);
1938
1939
when A_Path =>
1940
1941
return PARSE_Path (Element);
1942
1943
when A_Clause =>
1944
1945
return PARSE_Clause (Element);
1946
1947
when An_Exception_Handler =>
1948
1949
return Query_Array'
1950
(1 => (Single_Element_Query,
1951
Asis.Statements.Choice_Parameter_Specification'Access),
1952
1953
2 => (Element_List_Query,
1954
Asis.Statements.Exception_Choices'Access),
1955
1956
3 => (Element_List_Query_With_Boolean,
1957
Asis.Statements.Handler_Statements'Access, True));
1958
end case;
1959
end Appropriate_Queries;
1960
1961
end A4G.Queries;
b'\\ No newline at end of file'
Loggerhead is a web-based interface for Breezy
Version: 2.0.1