ocarina-analyzer-aadl-links.adb 141 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--          O C A R I N A . A N A L Y Z E R . A A D L . L I N K S           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--       Copyright (C) 2009 Telecom ParisTech, 2010-2014 ESA & ISAE.        --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
--                                                                          --
-- 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.                                       --
--                                                                          --
jhugues's avatar
jhugues committed
29
30
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
--                                                                          --
------------------------------------------------------------------------------

with Utils;

with Ocarina.Analyzer.Messages;
with Ocarina.Analyzer.AADL.Semantics;
with Ocarina.Analyzer.AADL.Finder;
with Ocarina.Analyzer.AADL.Naming_Rules;

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

package body Ocarina.Analyzer.AADL.Links is

   use Utils;
   use Ocarina.Analyzer.Messages;
   use Ocarina.Analyzer.AADL.Finder;
   use Ocarina.Analyzer.AADL.Naming_Rules;
   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Tree.Nodes;
   use Ocarina.ME_AADL.AADL_Tree.Nutils;
   use Ocarina.ME_AADL.AADL_Tree.Entities;
   use Ocarina.ME_AADL.AADL_Tree.Entities.Properties;

59
60
61
   Global_Root : Node_Id := No_Node;
   --  Store the root of the current AADL_Specification

62
   function Link_Declarations_Of_Package
63
64
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
65
66
67
68
   --  Perform all the designator and identifier links in the
   --  declarations of an AADL package.

   function Link_Declarations_Of_Property_Set
69
70
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
71
72
73
74
   --  Perform all the designator and identifier links in the
   --  declarations of an AADL property set.

   function Link_Component_Implementation_Subclauses
75
76
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
77
78
79
80
81
   --  Perform all the designator and identifier links in the
   --  subclauses (call sequences, subcomponents...) of a component
   --  implementation.

   function Link_Component_Type_Subclauses
82
83
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
84
   --  Perform all the designator and identifier links in the
85
   --  subclauses (features...) of a component type.
86
87

   function Link_Feature_Group_Type_Subclauses
88
89
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
90
91
92
93
94
   --  Perform all the designator and identifier links in the
   --  subclauses (features...) of a port group (AADL_V1) or
   --  a feature group (AADL_V2)

   function Link_Properties_Of_Component_Type
95
96
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
97
98
99
100
   --  Perform all the designator and identifier links in the property
   --  associations of a component type.

   function Link_Properties_Of_Component_Implementation
101
102
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
103
104
105
106
   --  Perform all the designator and identifier links in the property
   --  associations of a component implementation.

   function Link_Properties_Of_Feature_Group_Type
107
108
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
109
110
111
112
113
114
115
116
   --  Perform all the designator and identifier links in the property
   --  associations of a port group (AADL_V1) or a feature group (AADL_V2)

   function Link_Property_Value
     (Root               : Node_Id;
      Container          : Node_Id;
      Property_Container : Node_Id;
      Node               : Node_Id;
117
      Property_Type      : Node_Id) return Boolean;
118
119
120
121
122
   --  Perform all the designator and identifier links in the property
   --  value 'Node'.

   function Link_Type_Designator
     (Root       : Node_Id;
123
      Designator : Node_Id) return Boolean;
124
125
126
   --  Perform the designator and identifier link of a property type.

   function Link_Properties_Of_Package
127
128
     (Root : Node_Id;
      Node : Node_Id) return Boolean;
129
130
131
132
133
134
135
136
137
138
139
140
   --  Perform all the designator and identifier links in the property
   --  associations of an AADL package.

   procedure Retrieve_Connection_End
     (Component          :     Node_Id;
      Connection_End     :     Node_Id;
      Corresponding_Node : out Node_Id;
      Is_Local           : out Boolean);
   --  Find the node corresponding to the end of a connection

   function Link_Flow_Feature
     (Feature_Identifier : Node_Id;
141
      Component          : Node_Id) return Node_Id;
142
143
144
145
146
147
148
149
   --  Return the feature instance having the identifier
   --  'Feature_Identifier' in the component 'Component'. Perform all
   --  the necessary links between the reference and the found
   --  entities.

   function Link_Flow_Of_Subcomponent
     (Flow_Identifier : Node_Id;
      Component       : Node_Id;
150
      In_Modes        : Node_Id := No_Node) return Node_Id;
151
152
153
154
155
156
157
158
159
160
161
162
163
164
   --  Return the flow instance having the identifier
   --  'Flow_Identifier' in the component 'Component' in the modes
   --  'In_Modes'. This function performs all the necessary links
   --  between the reference and the found entities.

   function Link_Flow_Connections (Flow : Node_Id) return Boolean;
   --  Performs links and checks on the flow connection list.

   function Equals (Unit_Id_1 : Node_Id; Unit_Id_2 : Node_Id) return Boolean;
   --  Return True when the two identifiers have the same name. This
   --  function is *not* case sensitive.

   function Unwind_Units_Type
     (Root          : Node_Id;
165
      Property_Type : Node_Id) return Node_Id;
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
   --  Return the units type declaration corresponding to the given
   --  property type. If the type definition does not contain any unit
   --  definition, then return No_Bode.

   ------------
   -- Equals --
   ------------

   function Equals (Unit_Id_1 : Node_Id; Unit_Id_2 : Node_Id) return Boolean is
   begin
      return To_Lower (Name (Unit_Id_1)) = To_Lower (Name (Unit_Id_2));
   end Equals;

   -------------------------------
   -- Link_Flow_Of_Subcomponent --
   -------------------------------

   function Link_Flow_Of_Subcomponent
     (Flow_Identifier : Node_Id;
      Component       : Node_Id;
186
      In_Modes        : Node_Id := No_Node) return Node_Id
187
188
   is
      pragma Assert (Kind (Flow_Identifier) = K_Entity_Reference);
189
190
191
      pragma Assert
        (Kind (Component) = K_Component_Implementation
         or else Kind (Component) = K_Component_Type);
192
193
194
195
196
197
198
199
200
201
202
203
204

      Pointed_Node      : Node_Id;
      Pointed_Component : Node_Id;
   begin
      --  The entity reference must be in the form "a.b", otherwise it
      --  cannot be a path of a subcomponent.

      if Length (Path (Flow_Identifier)) /= 2 then
         return No_Node;
      end if;

      --  Fetch "a" and link it

205
206
207
208
209
210
      Pointed_Node :=
        Find_Subcomponent
          (Component               => Component,
           Subcomponent_Identifier =>
             Item (First_Node (Path (Flow_Identifier))),
           In_Modes => In_Modes);
211
212
213
214
215
216
217
218
219
220
221
222

      Set_Corresponding_Entity
        (Item (First_Node (Path (Flow_Identifier))),
         Pointed_Node);

      Display_Node_Link
        (Item (First_Node (Path (Flow_Identifier))),
         Pointed_Node);

      if Present (Pointed_Node) then
         --  Fetch "b" and link it

223
224
         Pointed_Component :=
           Get_Referenced_Entity (Entity_Ref (Pointed_Node));
225

226
227
228
229
         Pointed_Node :=
           Find_Flow_Spec
             (Pointed_Component,
              Item (Next_Node (First_Node (Path (Flow_Identifier)))));
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

         Set_Corresponding_Entity
           (Item (Next_Node (First_Node (Path (Flow_Identifier)))),
            Pointed_Node);

         Set_Referenced_Entity (Flow_Identifier, Pointed_Node);

         Display_Node_Link
           (Item (Next_Node (First_Node (Path (Flow_Identifier)))),
            Pointed_Node);
      end if;

      return Pointed_Node;
   end Link_Flow_Of_Subcomponent;

   -----------------------
   -- Link_Flow_Feature --
   -----------------------

   function Link_Flow_Feature
     (Feature_Identifier : Node_Id;
251
      Component          : Node_Id) return Node_Id
252
253
   is
      pragma Assert (Kind (Feature_Identifier) = K_Entity_Reference);
254
255
256
      pragma Assert
        (Kind (Component) = K_Component_Implementation
         or else Kind (Component) = K_Component_Type);
257
258
259
260

      Pointed_Node       : Node_Id;
      Pointed_Port_Group : Node_Id;
   begin
261
262
263
264
265
      Pointed_Node :=
        Find_Feature
          (Component          => Component,
           Feature_Identifier =>
             Item (First_Node (Path (Feature_Identifier))));
266
267
268
269
270
271
272
273
274
275

      Set_Corresponding_Entity
        (Item (First_Node (Path (Feature_Identifier))),
         Pointed_Node);

      Display_Node_Link
        (Item (First_Node (Path (Feature_Identifier))),
         Pointed_Node);

      if Present (Next_Node (First_Node (Path (Feature_Identifier)))) then
276
277
278
279
280
281
282
         Pointed_Port_Group :=
           Get_Referenced_Entity (Entity_Ref (Pointed_Node));
         Pointed_Node :=
           Find_Feature
             (Component          => Pointed_Port_Group,
              Feature_Identifier =>
                Item (Next_Node (First_Node (Path (Feature_Identifier)))));
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309

         Set_Corresponding_Entity
           (Item (Next_Node (First_Node (Path (Feature_Identifier)))),
            Pointed_Node);

         Set_Referenced_Entity (Feature_Identifier, Pointed_Node);

         Display_Node_Link
           (Next_Node (First_Node (Path (Feature_Identifier))),
            Pointed_Node);
      end if;

      if Present (Pointed_Node)
        and then Kind (Pointed_Node) /= K_Port_Spec
        and then Kind (Pointed_Node) /= K_Feature_Group_Spec
        and then Kind (Pointed_Node) /= K_Parameter
      then
         return No_Node;
      else
         return Pointed_Node;
      end if;
   end Link_Flow_Feature;

   ---------------
   -- Link_Call --
   ---------------

310
   function Link_Call (Root : Node_Id; Node : Node_Id) return Boolean is
311
312
313
314
315
316
317
318
319
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Subprogram_Call);
      pragma Assert (Kind (Entity_Ref (Node)) = K_Entity_Reference);

      Success            : Boolean := True;
      Pointed_Node       : Node_Id := No_Node;
      Other_Pointed_Node : Node_Id := No_Node;

      Subprogram_Ref  : constant Node_Id := Entity_Ref (Node);
320
321
      Pack_Identifier : constant Node_Id :=
        Namespace_Identifier (Subprogram_Ref);
322
323
324
325

      Pointed_Node_Is_Ok       : Boolean;
      Other_Pointed_Node_Is_Ok : Boolean;
   begin
326
327
      --  Either look in available components

328
329
330
331
332
      Pointed_Node :=
        Find_Component_Classifier
          (Root                 => Root,
           Package_Identifier   => Pack_Identifier,
           Component_Identifier => Identifier (Subprogram_Ref));
333

334
335
336
      --  or in local subclauses

      if No (Pointed_Node) then
337
338
339
340
         Pointed_Node :=
           Find_Subclause
             (Container_Component (Parent_Sequence (Node)),
              Identifier (Subprogram_Ref));
341
342
      end if;

343
      if Present (Next_Node (First_Node (Path (Subprogram_Ref)))) then
344
345
346
347
348
349
         Other_Pointed_Node :=
           Find_Component_Classifier
             (Root                 => Root,
              Package_Identifier   => Pack_Identifier,
              Component_Identifier =>
                Item (First_Node (Path (Subprogram_Ref))));
350
351
352

         if Present (Other_Pointed_Node)
           and then Kind (Other_Pointed_Node) = K_Component_Type
353
354
355
356
357
           and then
           (Component_Category'Val (Category (Other_Pointed_Node)) = CC_Thread
            or else
              Component_Category'Val (Category (Other_Pointed_Node)) =
              CC_Data)
358
359
360
361
362
363
364
         then
            --  Link the Identifier to its corresponding component

            Set_Corresponding_Entity
              (Item (First_Node (Path (Subprogram_Ref))),
               Other_Pointed_Node);

365
366
367
368
369
            Other_Pointed_Node :=
              Find_Feature
                (Component          => Other_Pointed_Node,
                 Feature_Identifier =>
                   Item (Next_Node (First_Node (Path (Subprogram_Ref)))));
370
371
372
373
374
         else
            Other_Pointed_Node := No_Node;
         end if;
      end if;

375
376
      Pointed_Node_Is_Ok :=
        Present (Pointed_Node)
377
378
        and then
        ((Kind (Pointed_Node) = K_Component_Type
379
380
          or else Kind (Pointed_Node) = K_Component_Implementation
          or else Kind (Pointed_Node) = K_Subcomponent)
381

382
383
384
         and then
           Component_Category'Val (Category (Pointed_Node)) =
           CC_Subprogram);
385
386
387

      case AADL_Version is
         when AADL_V1 =>
388
389
            Other_Pointed_Node_Is_Ok :=
              Present (Other_Pointed_Node)
390
391
392
              and then Kind (Other_Pointed_Node) = K_Subprogram_Spec;

         when AADL_V2 =>
393
394
            Other_Pointed_Node_Is_Ok :=
              Present (Other_Pointed_Node)
395
396
397
398
              and then Kind (Other_Pointed_Node) = K_Subcomponent_Access;
      end case;

      if Pointed_Node_Is_Ok and then Other_Pointed_Node_Is_Ok then
399
400
401
402
403
         DAE (Node1 => Node, Message1 => " points to ", Node2 => Pointed_Node);
         DAE
           (Node1    => Node,
            Message1 => " also points to ",
            Node2    => Other_Pointed_Node);
404
405
406
407
408
409
410
411
412
413
414
         Success := False;

      elsif Pointed_Node_Is_Ok then
         Set_Referenced_Entity (Entity_Ref (Node), Pointed_Node);

      elsif Other_Pointed_Node_Is_Ok then
         --  In this case, the Other_Pointed_Node is a subprogram
         --  spec, we must link it now because the data component the
         --  subprogram spec may be declared at the end of the AADL
         --  specification.

415
416
         Success :=
           Link_Feature (Root, Other_Pointed_Node, No_Node) and then Success;
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

         Set_Referenced_Entity (Entity_Ref (Node), Other_Pointed_Node);

      else
         DLTWN (Node, Pointed_Node);
         Success := False;
      end if;

      return Success;
   end Link_Call;

   ----------------------------------------------
   -- Link_Component_Implementation_Subclauses --
   ----------------------------------------------

   function Link_Component_Implementation_Subclauses
433
434
     (Root : Node_Id;
      Node : Node_Id) return Boolean
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Component_Implementation);

      List_Node         : Node_Id;
      Call_List_Node    : Node_Id;
      Success           : Boolean := True;
      Subclause_Success : Boolean := True;
   begin
      --  modes, connections and flows are linked only if
      --  subcomponents and features were correctly linked. Indeed,
      --  those subclauses may access elements pointed by
      --  subcomponents or features.

      if not Is_Empty
450
451
452
453
          (Ocarina.ME_AADL.AADL_Tree.Nodes.Refines_Type (Node))
      then
         List_Node :=
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Refines_Type (Node));
454
455

         while Present (List_Node) loop
456
457
            Success :=
              Link_Feature (Root, List_Node, No_Node) and then Success;
458
459
460
461
462
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      if not Is_Empty
463
464
          (Ocarina.ME_AADL.AADL_Tree.Nodes.Subcomponents (Node))
      then
465
         List_Node :=
466
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Subcomponents (Node));
467
468

         while Present (List_Node) loop
469
470
            Success :=
              Link_Subcomponent (Root, List_Node)
471
472
473
474
475
476
              and then Link_In_Modes_Statement (Node, In_Modes (List_Node))
              and then Success;
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

477
      if not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Calls (Node)) then
478
         List_Node :=
479
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Calls (Node));
480
481

         while Present (List_Node) loop
482
483
            Success :=
              Link_In_Modes_Statement (Node, In_Modes (List_Node))
484
485
486
487
488
489
              and then Success;

            if not Is_Empty (Subprogram_Calls (List_Node)) then
               Call_List_Node := First_Node (Subprogram_Calls (List_Node));

               while Present (Call_List_Node) loop
490
                  Success := Link_Call (Root, Call_List_Node) and then Success;
491
492
493
494
495
496
497
498
499
500
501
502
                  Call_List_Node := Next_Node (Call_List_Node);
               end loop;
            end if;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      Subclause_Success := Success;

      if Subclause_Success
        and then not Is_Empty
503
          (Ocarina.ME_AADL.AADL_Tree.Nodes.Connections (Node))
504
505
      then
         List_Node :=
506
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Connections (Node));
507
508

         while Present (List_Node) loop
509
            Global_Root := Root;
510
511
            Success     :=
              Link_Connection (Node, List_Node)
512
513
              and then Link_In_Modes_Statement (Node, In_Modes (List_Node))
              and then Success;
514
            List_Node   := Next_Node (List_Node);
515
            Global_Root := No_Node;
516
517
518
519
         end loop;
      end if;

      if Subclause_Success
520
        and then not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node))
521
522
      then
         List_Node :=
523
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node));
524
525
526
527
528

         while Present (List_Node) loop
            if Kind (List_Node) = K_End_To_End_Flow_Refinement
              or else Kind (List_Node) = K_End_To_End_Flow_Spec
            then
529
530
               Success :=
                 Link_End_To_End_Flow_Spec (Node, List_Node)
531
532
533
534
535
                 and then Link_In_Modes_Statement (Node, In_Modes (List_Node))
                 and then Success;
            elsif Kind (List_Node) = K_Flow_Implementation_Refinement
              or else Kind (List_Node) = K_Flow_Implementation
            then
536
537
               Success :=
                 Link_Flow_Implementation (Node, List_Node)
538
539
540
541
542
543
544
545
546
                 and then Link_In_Modes_Statement (Node, In_Modes (List_Node))
                 and then Success;
            end if;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      if Subclause_Success
547
        and then not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Modes (Node))
548
549
      then
         List_Node :=
550
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Modes (Node));
551
552
553

         while Present (List_Node) loop
            if Kind (List_Node) = K_Mode_Transition then
554
555
               Success :=
                 Link_Mode_Transition (Node, List_Node) and then Success;
556
557
558
559
560
561
562
563
564
565
566
567
568
569
            end if;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      return Success;
   end Link_Component_Implementation_Subclauses;

   -----------------------------------------------------
   -- Link_Component_Implementation_To_Component_Type --
   -----------------------------------------------------

   function Link_Component_Implementation_To_Component_Type
570
571
     (Root : Node_Id;
      Node : Node_Id) return Boolean
572
573
574
575
576
577
578
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Component_Implementation);

      Success      : Boolean := True;
      Pointed_Node : Node_Id;
   begin
579
580
581
582
583
      Pointed_Node :=
        Find_Component_Classifier
          (Root                 => Root,
           Package_Identifier   => No_Node,
           Component_Identifier => Component_Type_Identifier (Node));
584
585
586
587
      --  According to the AADL syntax, the component type must be in
      --  the same namespace as the implementations.

      if No (Pointed_Node) then
588
589
590
         DAE
           (Node1    => Node,
            Message1 => " implements a component type that does not exist");
591
         Success := False;
592

593
      elsif Kind (Pointed_Node) /= K_Component_Type then
594
595
596
597
598
         DAE
           (Node1    => Node,
            Message1 => " implements ",
            Node2    => Pointed_Node,
            Message2 => ", which is not a component type");
599
         Success := False;
600

601
      elsif Category (Pointed_Node) /= Category (Node) then
602
603
604
605
606
         DAE
           (Node1    => Node,
            Message1 => " implements ",
            Node2    => Pointed_Node,
            Message2 => ", which is of different kind");
607
608
         Success := False;
      else
609
610
611
         Set_Corresponding_Entity
           (Component_Type_Identifier (Node),
            Pointed_Node);
612
613
614
615
616
617
618
619
620
621
622
         Success := True;
      end if;

      return Success;
   end Link_Component_Implementation_To_Component_Type;

   -----------------------------------------------
   -- Link_Component_Or_Feature_Group_Extension --
   -----------------------------------------------

   function Link_Component_Or_Feature_Group_Extension
623
624
     (Root : Node_Id;
      Node : Node_Id) return Boolean
625
626
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
627
628
629
630
      pragma Assert
        (Kind (Node) = K_Component_Implementation
         or else Kind (Node) = K_Component_Type
         or else Kind (Node) = K_Feature_Group_Type);
631
632
633
634
635
636

      Success      : Boolean := True;
      Pointed_Node : Node_Id;
   begin
      if Present (Parent (Node)) then
         declare
637
            Component_Ref   : constant Node_Id := Parent (Node);
638
639
640
641
642
            Pack_Identifier : Node_Id;
         begin
            Pack_Identifier := Namespace_Identifier (Component_Ref);

            if Kind (Node) = K_Feature_Group_Type then
643
644
645
646
647
               Pointed_Node :=
                 Find_Port_Group_Classifier
                   (Root                  => Root,
                    Package_Identifier    => Pack_Identifier,
                    Port_Group_Identifier => Identifier (Component_Ref));
648
            else
649
650
651
652
653
               Pointed_Node :=
                 Find_Component_Classifier
                   (Root                 => Root,
                    Package_Identifier   => Pack_Identifier,
                    Component_Identifier => Identifier (Component_Ref));
654
655
656
657
658

            end if;
         end;

         if No (Pointed_Node) then
659
660
661
            DAE
              (Node1    => Node,
               Message1 => " extends something that does not exist");
662
663
            Success := False;
         elsif Kind (Pointed_Node) /= Kind (Node) then
664
665
666
667
668
            DAE
              (Node1    => Node,
               Message1 => " extends ",
               Node2    => Pointed_Node,
               Message2 => ", which is not of the same kind");
669
670
            Success := False;
         elsif Kind (Node) /= K_Feature_Group_Type
671
672
673
           and then
           (Category (Pointed_Node) /= Component_Category'Pos (CC_Abstract)
            and then Category (Pointed_Node) /= Category (Node))
674
         then
675
676
677
678
679
            DAE
              (Node1    => Node,
               Message1 => " extends ",
               Node2    => Pointed_Node,
               Message2 => ", which is of different type");
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
            Success := False;
         else
            Set_Referenced_Entity (Parent (Node), Pointed_Node);
            Success := True;
         end if;
      end if;

      return Success;
   end Link_Component_Or_Feature_Group_Extension;

   ------------------------------------
   -- Link_Component_Type_Subclauses --
   ------------------------------------

   function Link_Component_Type_Subclauses
695
696
     (Root : Node_Id;
      Node : Node_Id) return Boolean
697
698
699
700
701
702
703
704
705
706
707
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Component_Type);

      List_Node : Node_Id;
      Success   : Boolean := True;
   begin
      if not Is_Empty (Features (Node)) then
         List_Node := First_Node (Features (Node));

         while Present (List_Node) loop
708
            Success   := Link_Feature (Root, List_Node, Node) and then Success;
709
710
711
712
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

713
      if not Is_Empty (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node)) then
714
         List_Node :=
715
           First_Node (Ocarina.ME_AADL.AADL_Tree.Nodes.Flows (Node));
716
717

         while Present (List_Node) loop
718
            Success   := Link_Flow_Spec (Node, List_Node) and then Success;
719
720
721
722
723
724
725
726
727
728
729
730
731
            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      return Success;
   end Link_Component_Type_Subclauses;

   ---------------------
   -- Link_Connection --
   ---------------------

   function Link_Connection
     (Component : Node_Id;
732
      Node      : Node_Id) return Boolean
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
   is
      Success              : Boolean := True;
      Source_Node          : Node_Id;
      Destination_Node     : Node_Id;
      Source_Is_Local      : Boolean;
      Destination_Is_Local : Boolean;
   begin
      if Is_Refinement (Node) then
         return True;
      end if;

      pragma Assert (Kind (Component) = K_Component_Implementation);
      pragma Assert (Kind (Node) = K_Connection);
      pragma Assert (Kind (Source (Node)) = K_Entity_Reference);
      pragma Assert (Kind (Destination (Node)) = K_Entity_Reference);

      --  Connection source

      Retrieve_Connection_End
        (Component          => Component,
         Connection_End     => Source (Node),
         Corresponding_Node => Source_Node,
         Is_Local           => Source_Is_Local);

      if No (Source_Node) then
758
759
760
         DAE
           (Node1    => Source (Node),
            Message1 => "does not point to anything");
761
762
763
764
765
766
767
768
769
770
771
772
         Success := False;
      end if;

      --  Connection destination

      Retrieve_Connection_End
        (Component          => Component,
         Connection_End     => Destination (Node),
         Corresponding_Node => Destination_Node,
         Is_Local           => Destination_Is_Local);

      if No (Destination_Node) then
773
774
775
         DAE
           (Node1    => Destination (Node),
            Message1 => "does not point to anything");
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
         Success := False;
      end if;

      if Success then
         Set_Referenced_Entity (Source (Node), Source_Node);
         Display_Node_Link (Identifier (Source (Node)), Source_Node);
         Set_Referenced_Entity (Destination (Node), Destination_Node);
         Display_Node_Link (Identifier (Destination (Node)), Destination_Node);
      end if;

      return Success;
   end Link_Connection;

   -------------------------------------
   -- Link_Declarations_Of_Namespaces --
   -------------------------------------

793
   function Link_Declarations_Of_Namespaces (Root : Node_Id) return Boolean is
794
795
796
797
798
799
800
801
802
803
804
805
      pragma Assert (Kind (Root) = K_AADL_Specification);

      List_Node : Node_Id;
      Success   : Boolean := True;
   begin
      Push_Scope (Entity_Scope (Root));

      if not Is_Empty (Declarations (Root)) then
         List_Node := First_Node (Declarations (Root));

         while Present (List_Node) loop
            if Kind (List_Node) = K_Package_Specification then
806
807
               Success :=
                 Link_Declarations_Of_Package (Root => Root, Node => List_Node)
808
809
810
                 and then Success;

            elsif Kind (List_Node) = K_Property_Set then
811
812
813
814
               Success :=
                 Link_Declarations_Of_Property_Set
                   (Root => Root,
                    Node => List_Node)
815
816
817
818
819
820
                 and then Success;

            elsif Kind (List_Node) = K_Component_Type
              or else Kind (List_Node) = K_Component_Implementation
              or else Kind (List_Node) = K_Feature_Group_Type
            then
821
822
823
824
               Success :=
                 Link_Component_Or_Feature_Group_Extension
                   (Root => Root,
                    Node => List_Node)
825
826
827
828
                 and then Success;
            end if;

            if Kind (List_Node) = K_Component_Implementation then
829
830
831
832
               Success :=
                 Link_Component_Implementation_To_Component_Type
                   (Root,
                    List_Node)
833
834
835
836
                 and then Success;
            end if;

            if Kind (List_Node) = K_Feature_Group_Type then
837
838
               Success :=
                 Link_Inverse_Of_Feature_Group_Type (Root, List_Node)
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
                 and then Success;
            end if;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      Pop_Scope;
      return Success;
   end Link_Declarations_Of_Namespaces;

   ----------------------------------
   -- Link_Declarations_Of_Package --
   ----------------------------------

   function Link_Declarations_Of_Package
855
856
     (Root : Node_Id;
      Node : Node_Id) return Boolean
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Package_Specification);

      List_Node : Node_Id;
      Success   : Boolean := True;
   begin
      Push_Scope (Entity_Scope (Node));

      if not Is_Empty (Declarations (Node)) then
         List_Node := First_Node (Declarations (Node));

         while Present (List_Node) loop
            if Kind (List_Node) = K_Component_Type
              or else Kind (List_Node) = K_Component_Implementation
              or else Kind (List_Node) = K_Feature_Group_Type
            then
874
875
               Success :=
                 Link_Component_Or_Feature_Group_Extension (Root, List_Node)
876
877
878
879
                 and then Success;
            end if;

            if Kind (List_Node) = K_Component_Implementation then
880
881
882
883
               Success :=
                 Link_Component_Implementation_To_Component_Type
                   (Root,
                    List_Node)
884
885
886
887
                 and then Success;
            end if;

            if Kind (List_Node) = K_Feature_Group_Type then
888
889
               Success :=
                 Link_Inverse_Of_Feature_Group_Type (Root, List_Node)
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
                 and then Success;
            end if;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      Pop_Scope;
      return Success;
   end Link_Declarations_Of_Package;

   ---------------------------------------
   -- Link_Declarations_Of_Property_Set --
   ---------------------------------------

   function Link_Declarations_Of_Property_Set
906
907
     (Root : Node_Id;
      Node : Node_Id) return Boolean
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
   is
      pragma Assert (Kind (Root) = K_AADL_Specification);
      pragma Assert (Kind (Node) = K_Property_Set);

      List_Node : Node_Id;
      Success   : Boolean := True;
   begin
      Push_Scope (Entity_Scope (Node));

      if not Is_Empty (Declarations (Node)) then
         List_Node := First_Node (Declarations (Node));

         while Present (List_Node) loop
            case Kind (List_Node) is
               when K_Property_Definition_Declaration =>
923
924
                  Success :=
                    Link_Property_Name (Root, List_Node) and then Success;
925
926

               when K_Property_Type_Declaration =>
927
928
                  Success :=
                    Link_Property_Type (Root, List_Node) and then Success;
929
930

               when K_Constant_Property_Declaration =>
931
932
                  Success :=
                    Link_Property_Constant (Root, List_Node) and then Success;
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951

               when others =>
                  raise Program_Error;
            end case;

            List_Node := Next_Node (List_Node);
         end loop;
      end if;

      Pop_Scope;
      return Success;
   end Link_Declarations_Of_Property_Set;

   -------------------------------
   -- Link_End_To_End_Flow_Spec --
   -------------------------------

   function Link_End_To_End_Flow_Spec
     (Component : Node_Id;
952
      Flow      : Node_Id) return Boolean
953
954
   is
      pragma Assert (Kind (Component) = K_Component_Implementation);
955
956
957
      pragma Assert
        (Kind (Flow) = K_End_To_End_Flow_Refinement
         or else Kind (Flow) = K_End_To_End_Flow_Spec);
958
959
960
961
962
963
964
965
966

      Success      : Boolean := True;
      Pointed_Node : Node_Id;
   begin
      case Kind (Flow) is
         when K_End_To_End_Flow_Spec =>
            --  The Source_Flow field must point to a subcomponent
            --  flow source or path.

967
968
969
970
971
            Pointed_Node :=
              Link_Flow_Of_Subcomponent
                (Component       => Component,
                 Flow_Identifier => Source_Flow (Flow),
                 In_Modes        => In_Modes (Flow));
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

            if No (Pointed_Node) then
               DLTWN (Source_Flow (Flow), Pointed_Node);
               Success := False;
            elsif Flow_Category'Val (Category (Pointed_Node)) /= FC_Source
              and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path
            then
               DAE
                 (Node1    => Source_Flow (Flow),
                  Message1 => " points to ",
                  Node2    => Pointed_Node,
                  Message2 => " which should be a flow source or flow path");
               Success := False;
            end if;

            --  The Sink_Flow field must point to a subcomponent flow
            --  sink or path.

990
991
992
993
994
            Pointed_Node :=
              Link_Flow_Of_Subcomponent
                (Component       => Component,
                 Flow_Identifier => Sink_Flow (Flow),
                 In_Modes        => In_Modes (Flow));
995
996
997
998
999
1000

            if No (Pointed_Node) then
               DLTWN (Sink_Flow (Flow), Pointed_Node);
               Success := False;
            elsif Flow_Category'Val (Category (Pointed_Node)) /= FC_Sink
              and then Flow_Category'Val (Category (Pointed_Node)) /= FC_Path
For faster browsing, not all history is shown. View entire blame