ocarina-instances-queries.adb 21.9 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--            O C A R I N A . I N S T A N C E S . Q U E R I E S             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
hugues.jerome's avatar
hugues.jerome committed
9
--               Copyright (C) 2006-2010, GET-Telecom Paris.                --
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
--                                                                          --
-- Ocarina  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 2, or (at your option) any      --
-- later version. Ocarina 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 Ocarina; see file COPYING.   --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA.                                       --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable to be   --
-- covered  by the  GNU  General  Public  License. This exception does not  --
-- however invalidate  any other reasons why the executable file might be   --
-- covered by the GNU Public License.                                       --
--                                                                          --
--                 Ocarina is maintained by the Ocarina team                --
--                       (ocarina-users@listes.enst.fr)                     --
--                                                                          --
------------------------------------------------------------------------------

with Namet;

with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Entities;
with Ocarina.ME_AADL.AADL_Instances.Entities.Properties;
with Ocarina.ME_AADL.AADL_Tree.Entities.Properties;

package body Ocarina.Instances.Queries is

   use Namet;

   use Ocarina.ME_AADL.AADL_Tree.Nodes;
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
   use Ocarina.ME_AADL.AADL_Instances.Entities;
   use Ocarina.ME_AADL.AADL_Tree.Entities.Properties;

hugues.jerome's avatar
hugues.jerome committed
51
52
   package ATN  renames Ocarina.ME_AADL.AADL_Tree.Nodes;
   package AIN  renames Ocarina.ME_AADL.AADL_Instances.Nodes;
53
   package AIEP renames Ocarina.ME_AADL.AADL_Instances.Entities.Properties;
hugues.jerome's avatar
hugues.jerome committed
54
   package ATE  renames Ocarina.ME_AADL.AADL_Tree.Entities;
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

   -------------------------------------
   -- Compute_Absolute_Name_Of_Entity --
   -------------------------------------

   function Compute_Absolute_Name_Of_Entity
     (Entity    : Node_Id;
      Separator : Name_Id := No_Name)
     return Name_Id
   is
      pragma Assert (Present (Entity));

      Parent_Name      : Name_Id;
      Entity_Name      : Name_Id;
      Actual_Separator : Name_Id := Separator;
   begin
      if Actual_Separator = No_Name then
         Set_Str_To_Name_Buffer (".");
         Actual_Separator := Name_Find;
      end if;

      case AIN.Kind (Entity) is
         when K_Component_Instance =>
            if Parent_Subcomponent (Entity) = No_Node then
               --  If we are processing the top level system

               Entity_Name := No_Name;
            else
               Entity_Name := Compute_Absolute_Name_Of_Entity
                 (Parent_Subcomponent (Entity), Actual_Separator);
            end if;

         when K_Subcomponent_Instance
           | K_Feature_Instance
           | K_Port_Spec_Instance
           | K_Subprogram_Spec_Instance
           | K_Parameter_Instance
           | K_Subcomponent_Access_Instance
           | K_Connection_Instance
           | K_Call_Sequence_Instance =>
            Parent_Name := Compute_Absolute_Name_Of_Entity
              (Parent_Component (Entity), Actual_Separator);

            if Parent_Name /= No_Name then
               Get_Name_String (Parent_Name);
               Get_Name_String_And_Append (Actual_Separator);
               Get_Name_String_And_Append (Get_Name_Of_Entity (Entity));
            else
               Get_Name_String (Get_Name_Of_Entity (Entity));
            end if;

            Entity_Name := Name_Find;

         when others =>
            Entity_Name := No_Name;
      end case;

      return Entity_Name;
   end Compute_Absolute_Name_Of_Entity;

   -------------------------
   -- Is_Defined_Property --
   -------------------------

   function Is_Defined_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
   begin
      return Present (AIEP.Find_Property_Association_From_Name
                        (Property_List => AIN.Properties (Entity),
hugues.jerome's avatar
hugues.jerome committed
128
129
                         Property_Name => Name,
                         In_Mode       => In_Mode));
130
131
132
133
134
135
136
137
138
139
140
141
   end Is_Defined_Property;

   function Is_Defined_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
      Name2 : Name_Id;
   begin
      Set_Str_To_Name_Buffer (Name);
      Name2 := Name_find;
hugues.jerome's avatar
hugues.jerome committed
142
143

      return Is_Defined_Property (Entity, Name2, In_Mode);
144
145
146
147
148
149
150
151
152
153
   end Is_Defined_Property;

   ----------------------------
   -- Compute_Property_Value --
   ----------------------------

   function Compute_Property_Value (Property_Value : Node_Id) return Node_Id is
      pragma Assert (ATN.Kind (Property_Value) = K_Property_Value);

      Property_Expression : Node_Id;
hugues.jerome's avatar
hugues.jerome committed
154

155
156
157
   begin
      if Expanded_Single_Value (Property_Value) /= No_Node then
         Property_Expression := Expanded_Single_Value (Property_Value);
hugues.jerome's avatar
hugues.jerome committed
158

159
160
161
      elsif Expanded_Multi_Value (Property_Value) /= No_List then
         Property_Expression :=
           ATN.First_Node (Expanded_Multi_Value (Property_Value));
hugues.jerome's avatar
hugues.jerome committed
162

163
164
      elsif Single_Value (Property_Value) /= No_Node then
         Property_Expression := Single_Value (Property_Value);
hugues.jerome's avatar
hugues.jerome committed
165

166
167
      elsif Multi_Value (Property_Value) /= No_List then
         Property_Expression := ATN.First_Node (Multi_Value (Property_Value));
hugues.jerome's avatar
hugues.jerome committed
168

169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
      else
         Property_Expression := No_Node;
      end if;

      return Property_Expression;
   end Compute_Property_Value;

   ------------------------------
   -- Get_Property_Association --
   ------------------------------

   function Get_Property_Association
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
   begin
      return AIEP.Find_Property_Association_From_Name
        (Property_List => AIN.Properties (Entity),
         Property_Name => Name,
         In_Mode       => In_Mode);
   end Get_Property_Association;

   --------------------------
   -- Get_Boolean_Property --
   --------------------------

   function Get_Boolean_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
      Property_Value : Node_Id;
   begin
      Property_Value := Get_Value_Of_Property_Association
        (Entity, Name, In_Mode);

      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Boolean
         then
            return Get_Boolean_Of_Property_Value (Property_Value);
         else
            return False;
         end if;
      else
         return False;
      end if;
   end Get_Boolean_Property;

   ------------------------------
   -- Get_Enumeration_Property --
   ------------------------------

   function Get_Enumeration_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return String
   is
      Property_Value : Node_Id;
   begin
      Property_Value := Get_Value_Of_Property_Association
        (Entity, Name, In_Mode);

      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Enumeration
         then
            return Get_Enumeration_Of_Property_Value (Property_Value);
         else
            return "";
         end if;
      else
         return "";
      end if;
   end Get_Enumeration_Property;

   ------------------------------
   -- Get_Enumeration_Property --
   ------------------------------

   function Get_Enumeration_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Name_Id
   is
hugues.jerome's avatar
hugues.jerome committed
259
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
260
261
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
262
   begin
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Enumeration
         then
            return Get_Enumeration_Of_Property_Value (Property_Value);
         else
            return No_Name;
         end if;
      else
         return No_Name;
      end if;
   end Get_Enumeration_Property;

   ------------------------
   -- Get_Float_Property --
   ------------------------

   function Get_Float_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Long_Long_Float
   is
hugues.jerome's avatar
hugues.jerome committed
286
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
287
288
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
289
   begin
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value (Property_Value, True) = PT_Float
           or else Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Unsigned_Float
         then
            return Get_Float_Of_Property_Value (Property_Value);
         else
            return 0.0;
         end if;
      else
         return 0.0;
      end if;
   end Get_Float_Property;

   --------------------------
   -- Get_Integer_Property --
   --------------------------

   function Get_Integer_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Unsigned_Long_Long
   is
hugues.jerome's avatar
hugues.jerome committed
314
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
315
316
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
317
   begin
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value (Property_Value, True) = PT_Integer
           or else Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Unsigned_Integer
         then
            return Get_Integer_Of_Property_Value (Property_Value);
         else
            return 0;
         end if;
      else
         return 0;
      end if;
   end Get_Integer_Property;

   --------------------------
   -- Get_Integer_Property --
   --------------------------

   function Get_Integer_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return Unsigned_Long_Long
   is
      Property_Name : Name_Id;
   begin
      Property_Name := Get_String_Name (Name);
      return Get_Integer_Property (Entity, Property_Name, In_Mode);
   end Get_Integer_Property;

   ----------------------------
   -- Get_Reference_Property --
   ----------------------------

   function Get_Reference_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
      Property_Value : Node_Id;
   begin
      Property_Value := Get_Value_Of_Property_Association
        (Entity, Name, In_Mode);

      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Reference
         then
            return Get_Reference_Of_Property_Value (Property_Value);
         else
            return No_Node;
         end if;
      else
         return No_Node;
      end if;
   end Get_Reference_Property;

   -----------------------------
   -- Get_Classifier_Property --
   -----------------------------

   function Get_Classifier_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
hugues.jerome's avatar
hugues.jerome committed
386
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
387
388
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
389
   begin
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value
           (Property_Value, True) = PT_Classifier
         then
            return Get_Classifier_Of_Property_Value (Property_Value);
         else
            return No_Node;
         end if;
      else
         return No_Node;
      end if;
   end Get_Classifier_Property;

   function Get_Classifier_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
      N : Name_Id;
   begin
      N := Get_String_Name (Name);
      return Get_Classifier_Property (Entity, N, In_Mode);
   end Get_Classifier_Property;

   ------------------------
   -- Get_Range_Property --
   ------------------------

   function Get_Range_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
hugues.jerome's avatar
hugues.jerome committed
425
426
      Property : constant Node_Id := Get_Property_Association
        (Entity, Name, In_Mode);
427

hugues.jerome's avatar
hugues.jerome committed
428
429
430
431
   begin
      if No (Property)
        or else Get_Type_Of_Property (Property) /= PT_Range
      then
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
         return No_Node;
      end if;

      return Expanded_Single_Value (AIN.Property_Association_Value (Property));
   end Get_Range_Property;

   -----------------------
   -- Get_List_Property --
   -----------------------

   function Get_List_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return List_Id
   is
hugues.jerome's avatar
hugues.jerome committed
448
449
      Property : constant Node_Id := Get_Property_Association
        (Entity, Name, In_Mode);
450
   begin
hugues.jerome's avatar
hugues.jerome committed
451
452
      if No (Property)
        or else not Type_Of_Property_Is_A_List
hugues.jerome's avatar
hugues.jerome committed
453
        (ATE.Get_Referenced_Entity (AIN.Property_Name (Property)))
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
      then
         return No_List;
      end if;

      return Expanded_Multi_Value (AIN.Property_Association_Value (Property));
   end Get_List_Property;

   function Get_List_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return List_Id
   is
   begin
      return Get_List_Property (Entity, Get_String_Name (Name), In_Mode);
   end Get_List_Property;

   -------------------------
   -- Get_String_Property --
   -------------------------

   function Get_String_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return String
   is
hugues.jerome's avatar
hugues.jerome committed
481
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
482
483
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
484
   begin
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value (Property_Value, True) = PT_String then
            return Get_String_Of_Property_Value (Property_Value);
         else
            return "";
         end if;
      else
         return "";
      end if;
   end Get_String_Property;

   function Get_String_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Name_Id
   is
hugues.jerome's avatar
hugues.jerome committed
502
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
503
504
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
505
   begin
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
      if Property_Value /= No_Node then
         if Get_Type_Of_Property_Value (Property_Value, True) = PT_String then
            return Get_String_Of_Property_Value (Property_Value);
         else
            return No_Name;
         end if;
      else
         return No_Name;
      end if;
   end Get_String_Property;

   function Get_String_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return Name_Id
   is
      Name2          : Name_Id;
   begin
      Set_Str_To_Name_Buffer (Name);
      Name2 := Name_Find;

hugues.jerome's avatar
hugues.jerome committed
528
      return Get_String_Property (Entity, Name2, In_Mode);
529
530
531
532
533
534
535
536
537
538
539
540
   end Get_String_Property;

   ---------------------------------------
   -- Get_Value_Of_Property_Association --
   ---------------------------------------

   function Get_Value_Of_Property_Association
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Node_Id
   is
hugues.jerome's avatar
hugues.jerome committed
541
542
543
544
      Property : constant Node_Id := Get_Property_Association
        (Entity, Name, In_Mode);
      Value : Node_Id := No_Node;

545
   begin
hugues.jerome's avatar
hugues.jerome committed
546
547
      if Present (Property) then
         Value := Compute_Property_Value
548
549
           (AIN.Property_Association_Value (Property));
      end if;
hugues.jerome's avatar
hugues.jerome committed
550
      return Value;
551
552
553
554
555
556
557
558
559
560
561
562
   end Get_Value_Of_Property_Association;

   ---------------------------------
   -- Is_Defined_Boolean_Property --
   ---------------------------------

   function Is_Defined_Boolean_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
563
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
564
565
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
566
   begin
567
568
569
570
571
572
573
574
575
576
577
578
579
580
      return Present (Property_Value) and then
        Get_Type_Of_Property_Value (Property_Value, True) = PT_Boolean;
   end Is_Defined_Boolean_Property;

   -------------------------------------
   -- Is_Defined_Enumeration_Property --
   -------------------------------------

   function Is_Defined_Enumeration_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
581
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
582
583
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
584
   begin
585
586
587
588
589
590
591
592
593
594
595
596
597
598
      return Present (Property_Value) and then
        Get_Type_Of_Property_Value (Property_Value, True) = PT_Enumeration;
   end Is_Defined_Enumeration_Property;

   -------------------------------
   -- Is_Defined_Float_Property --
   -------------------------------

   function Is_Defined_Float_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
599
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
600
601
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
602
   begin
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
      return Present (Property_Value) and then
        (Get_Type_Of_Property_Value (Property_Value, True) = PT_Float
         or else Get_Type_Of_Property_Value (Property_Value, True) =
         PT_Unsigned_Float);
   end Is_Defined_Float_Property;

   ---------------------------------
   -- Is_Defined_Integer_Property --
   ---------------------------------

   function Is_Defined_Integer_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
619
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
620
621
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
622
   begin
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
      return Present (Property_Value) and then
        (Get_Type_Of_Property_Value (Property_Value, True) = PT_Integer
         or else  Get_Type_Of_Property_Value (Property_Value, True) =
         PT_Unsigned_Integer);
   end Is_Defined_Integer_Property;

   -----------------------------------
   -- Is_Defined_Reference_Property --
   -----------------------------------

   function Is_Defined_Reference_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
639
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
640
641
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
642
   begin
643
644
645
646
647
648
649
650
651
652
653
654
655
656
      return Present (Property_Value) and then
        Get_Type_Of_Property_Value (Property_Value, True) = PT_Reference;
   end Is_Defined_Reference_Property;

   ------------------------------------
   -- Is_Defined_Classifier_Property --
   ------------------------------------

   function Is_Defined_Classifier_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
657
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
658
659
        (Entity, Name, In_Mode);

hugues.jerome's avatar
hugues.jerome committed
660
   begin
661
662
663
664
665
666
667
668
669
670
671
672
673
674
      return Present (Property_Value) and then
        Get_Type_Of_Property_Value (Property_Value, True) = PT_Classifier;
   end Is_Defined_Classifier_Property;

   -------------------------------
   -- Is_Defined_Range_Property --
   -------------------------------

   function Is_Defined_Range_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
675
676
677
      Property : constant Node_Id := Get_Property_Association
        (Entity, Name, In_Mode);

678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
   begin
      return Present (Property) and then
        Get_Type_Of_Property_Value
        (AIN.Property_Association_Value (Property), True) = PT_Range;
   end Is_Defined_Range_Property;

   ------------------------------
   -- Is_Defined_List_Property --
   ------------------------------

   function Is_Defined_List_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
694
695
      Property : constant Node_Id := Get_Property_Association
        (Entity, Name, In_Mode);
696
697
698
   begin
      return Present (Property)
        and then Type_Of_Property_Is_A_List
hugues.jerome's avatar
hugues.jerome committed
699
        (ATE.Get_Referenced_Entity (AIN.Property_Name (Property)));
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
   end Is_Defined_List_Property;

   function Is_Defined_List_Property
     (Entity  : Node_Id;
      Name    : String;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
   begin
      return Is_Defined_Property (Entity, Get_String_Name (Name), In_Mode);
   end Is_Defined_List_Property;

   --------------------------------
   -- Is_Defined_String_Property --
   --------------------------------

   function Is_Defined_String_Property
     (Entity  : Node_Id;
      Name    : Name_Id;
      In_Mode : Name_Id := No_Name)
     return Boolean
   is
hugues.jerome's avatar
hugues.jerome committed
722
      Property_Value : constant Node_Id := Get_Value_Of_Property_Association
723
        (Entity, Name, In_Mode);
hugues.jerome's avatar
hugues.jerome committed
724
   begin
725
726
727
728
729
      return Present (Property_Value) and then
        Get_Type_Of_Property_Value (Property_Value, True) = PT_String;
   end Is_Defined_String_Property;

end Ocarina.Instances.Queries;