1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--        O C A R I N A . A N A L Y Z E R . A A D L . A N N E X E S         --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--         Copyright (C) 2016-2019 ESA & ISAE, 2019-2020 OpenAADL           --
10
--                                                                          --
11
-- Ocarina  is free software; you can redistribute it and/or modify under   --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
15
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
16
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
--                    Ocarina is maintained by OpenAADL team                --
28
--                              (info@openaadl.org)                         --
29
--                                                                          --
30
------------------------------------------------------------------------------
31

32
with Ocarina.Analyzer;
33
with Ocarina.Analyzer.AADL.Finder;
34
with Ocarina.ME_AADL.AADL_Tree.Nodes;
35
with Ocarina.ME_REAL.Tokens;
36
with Ocarina.ME_AADL_EMA.EMA_Tokens;
37
with Ocarina.ME_AADL_BA.Tokens;
38
with Ocarina.Namet;
39
with Errors;
40
with Charset;
41
with Utils;
42

43
package body Ocarina.Analyzer.AADL.Annexes is
44

45
   use Ocarina.Analyzer.AADL.Finder;
46
   use Ocarina.ME_AADL.AADL_Tree.Nodes;
47
   use Ocarina.Namet;
48
   use Errors;
49

50
   package RT renames Ocarina.ME_REAL.Tokens;
51
   package EMAT renames Ocarina.ME_AADL_EMA.EMA_Tokens;
52
   package BAT renames Ocarina.ME_AADL_BA.Tokens;
53

54
   function Analyze (Language : Name_Id;
55
                     Language_Annex : String;
56
                     Root : Node_Id) return Boolean;
57
   --  Allows to analyze all the annexes in the aadl model
58

59
   procedure Execute_Analyze (Exist_Real : in out Boolean;
60
                              Exist_EMA  : in out Boolean;
61
                              Exist_BA   : in out Boolean;
62
                              Success    : in out Boolean;
63
                              Root       : Node_Id;
64
                              Ni         : Node_Id);
65

66
   -------------
67
   -- Analyze --
68
   -------------
69

70
   function Analyze (Language : Name_Id;
71
                     Language_Annex : String;
72
                     Root : Node_Id) return Boolean
73
   is
74 1
      Success : Boolean := False;
75

76
   begin
77

78 1
      if Language_Annex = RT.Language then
79
         --  For the REAL annex, analysis is done as part of the
80
         --  backend logic
81

82 1
         Success := True;
83
      else
84

85 1
         Success := Analyze (Language, Root);
86
      end if;
87

88 1
      Exit_On_Error (not Success, "Cannot analyze " &
89
      Charset.To_Upper (Language_Annex) & " specifications");
90

91 1
      return Success;
92
   end Analyze;
93

94
   --------------------------
95
   -- Find_Analyze_Annexes --
96
   --------------------------
97

98
   --  if we find a type of the annexes : real or ema
99
   --  then we call the function analyze once.
100
   --  The function analyze model will do the search of the
101
   --  rest of the annexes by her self
102

103 1
   function Find_Analyze_Annexes (Root : Node_Id) return Boolean
104
   is
105 1
      L1 : Node_List;
106 1
      L2 : Node_List;
107 1
      N1 : Node_Id;
108 1
      N2 : Node_Id;
109

110 1
      Success    : Boolean := True;
111 1
      Is_Library : Boolean := False;
112 1
      Exist_EMA  : Boolean := False;
113 1
      Exist_Real : Boolean := False;
114 1
      Exist_BA   : Boolean := False;
115
   begin
116 1
      L1 := Find_All_Declarations (Root,
117
                                   (K_Component_Type,
118
                                    K_Component_Implementation,
119
                                    K_Feature_Group_Type,
120
                                    K_Annex_Library));
121 1
      N1 := L1.First;
122 1
      while Present (N1) loop
123 1
         if Kind (N1) = K_Feature_Group_Type then
124 1
            L2 := Find_All_Subclauses
125
                  (N1, (1 => K_Annex_Subclause));
126
            --  FIXME : subclause annexes in Feature_Group_Type
127
            --  are not supported
128 1
         elsif Kind (N1) = K_Annex_Library then
129 0
            Is_Library := True;
130
         else
131 1
            L2 := Find_All_Subclauses (N1, (1 => K_Annex_Subclause));
132
         end if;
133

134 1
         if Is_Library then
135 0
            Execute_Analyze (Exist_Real, Exist_EMA, Exist_BA,
136
                             Success, Root, N1);
137
            --  FIXME : we can't have more than one annex library of the
138
            --  same type
139
         else
140 1
            N2 := L2.First;
141

142 1
            while Present (N2) loop
143 1
               Execute_Analyze (Exist_Real, Exist_EMA, Exist_BA,
144
                                Success, Root, N2);
145 1
               N2 := Next_Entity (N2);
146 1
            end loop;
147
         end if;
148

149 1
         N1 := Next_Entity (N1);
150 1
      end loop;
151

152 1
      return Success;
153 1
   end Find_Analyze_Annexes;
154

155
   ---------------------
156
   -- Execute_Analyze --
157
   ---------------------
158

159 1
   procedure Execute_Analyze (Exist_Real : in out Boolean;
160
                              Exist_EMA  : in out Boolean;
161
                              Exist_BA   : in out Boolean;
162
                              Success    : in out Boolean;
163
                              Root       : Node_Id;
164
                              Ni         : Node_Id)
165
   is
166 1
      Language : Name_Id;
167
   begin
168 1
      Language := Utils.To_Lower
169 1
            (Name (Identifier (Ni)));
170
      if Get_Name_String (Language) = RT.Language
171 1
         and then Present (Corresponding_Annex (Ni))
172
      then
173 1
         if not Exist_Real then
174
            Success := Success and then Analyze
175 1
            (Language, Get_Name_String (Language), Root);
176
         end if;
177 1
         Exist_Real := True;
178
      elsif Get_Name_String (Language) = EMAT.Language
179
         and then Present (Corresponding_Annex (Ni))
180
      then
181 0
         if not Exist_EMA then
182 0
            Success := Success and then Analyze
183 0
            (Language, Get_Name_String (Language), Root);
184
         end if;
185 0
         Exist_EMA := True;
186
      elsif Get_Name_String (Language) = BAT.Language
187 1
         and then Present (Corresponding_Annex (Ni))
188
      then
189 1
         if not Exist_BA then
190
            Success := Success and then Analyze
191 1
            (Language, Get_Name_String (Language), Root);
192
         end if;
193 1
         Exist_BA := True;
194
      end if;
195 1
   end Execute_Analyze;
196

197
end Ocarina.Analyzer.AADL.Annexes;

Read our documentation on viewing source code .

Loading