ocarina-options.adb 7.39 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--                      O C A R I N A . O P T I O N S                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--    Copyright (C) 2008-2009 Telecom ParisTech, 2010-2016 ESA & ISAE.      --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. 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.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27
28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29
30
31
--                                                                          --
------------------------------------------------------------------------------

32
with Ocarina.Namet; use Ocarina.Namet;
33

34
with GNAT.OS_Lib; use GNAT.OS_Lib;
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

package body Ocarina.Options is

   ----------------------
   -- Add_Library_Path --
   ----------------------

   procedure Add_Library_Path (Path : String) is
   begin
      if Path'Length > 0 then
         Library_Paths.Increment_Last;
         Set_Str_To_Name_Buffer (Path);
         Library_Paths.Table (Library_Paths.Last) := Name_Find;
      end if;
   end Add_Library_Path;

   --------------------------
   -- Default_Library_Path --
   --------------------------

   function Default_Library_Path return Name_Id is
      Name_Buffer_Bkp : constant String := Name_Buffer (1 .. Name_Len);
      Result          : Name_Id;
   begin
      if Installation_Directory = No_Name then
         raise Program_Error;
      end if;

      Get_Name_String (Installation_Directory);
64
      Add_Str_To_Name_Buffer ("share" & Directory_Separator);
65
66
      Add_Str_To_Name_Buffer ("ocarina" & Directory_Separator);
      if AADL_Version = AADL_V1 then
67
         Add_Str_To_Name_Buffer ("AADLv1" & Directory_Separator);
68
      elsif AADL_Version = AADL_V2 then
69
         Add_Str_To_Name_Buffer ("AADLv2" & Directory_Separator);
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
      end if;

      Result := Name_Find;
      Set_Str_To_Name_Buffer (Name_Buffer_Bkp);
      return Result;
   end Default_Library_Path;

   ------------------------
   -- Set_Current_Action --
   ------------------------

   procedure Set_Current_Action (Action : Action_Kind) is
   begin
      if Current_Action /= None then
         raise Invalid_Options;
      end if;

      Current_Action := Action;
   end Set_Current_Action;

   ------------------------
   -- Get_Current_Action --
   ------------------------

   function Get_Current_Action return Action_Kind is
   begin
      return Current_Action;
   end Get_Current_Action;

   --------------------------
   -- Reset_Current_Action --
   --------------------------

   procedure Reset_Current_Action is
   begin
      Current_Action := None;
   end Reset_Current_Action;

   ----------------------
   -- Set_Annex_Action --
   ----------------------

   procedure Set_Annex_Action (Action : Annex_Action_Kind) is
   begin
      Current_Annex_Action (Action) := 1;
   end Set_Annex_Action;

117
118
119
120
121
122
123
124
125
   ------------------------
   -- Unset_Annex_Action --
   ------------------------

   procedure Unset_Annex_Action (Action : Annex_Action_Kind) is
   begin
      Current_Annex_Action (Action) := 0;
   end Unset_Annex_Action;

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
   ----------------------
   -- Get_Annex_Action --
   ----------------------

   function Get_Annex_Action (Action : Annex_Action_Kind) return Byte is
   begin
      return Current_Annex_Action (Action);
   end Get_Annex_Action;

   ------------------------
   -- Reset_Annex_Action --
   ------------------------

   procedure Reset_Annex_Action is
   begin
      for I in Current_Annex_Action'Range loop
         Current_Annex_Action (I) := 0;
      end loop;
   end Reset_Annex_Action;

   --------------------------
   -- Process_Annex_Action --
   --------------------------

   procedure Process_Annex_Action (Parameters : String) is
      Tmp_Name : Name_Id;
   begin
      Name_Len := 0;

      for I in Parameters'Range loop
156
         if Parameters (I) = ',' or else I = Parameters'Last then
157
158
159
160
161
162
163
            if I = Parameters'Last then
               Add_Char_To_Name_Buffer (Parameters (I));
            end if;

            Tmp_Name := Name_Find;
            if Tmp_Name = Get_String_Name ("real") then
               Set_Annex_Action (Disable_REAL);
164
            elsif Tmp_Name = Get_String_Name ("behavior_specification") then
165
               Set_Annex_Action (Disable_BA);
166
167
            elsif Tmp_Name = Get_String_Name ("emv2") then
               Set_Annex_Action (Disable_EMA);
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
            elsif Tmp_Name = Get_String_Name ("all") then
               Set_Annex_Action (Disable_ALL);
               exit;
            else
               raise Invalid_Options;
            end if;

            Name_Len := 0;

         else
            Add_Char_To_Name_Buffer (Parameters (I));
         end if;
      end loop;
   end Process_Annex_Action;

   --------------------------
   -- Perform_Annex_Action --
   --------------------------

   function Perform_Annex_Action (Language : Name_Id) return Boolean is
188
189
190
191
      Behavior_Language_Name : constant Name_Id :=
        Get_String_Name ("behavior_specification");
      Real_Language_Name : constant Name_Id :=
        Get_String_Name ("real_specification");
192
193
      Error_Language_Name : constant Name_Id :=
        Get_String_Name ("emv2");
194
      Perform : Boolean := True;
195
196
197
   begin
      if Current_Annex_Action (Disable_ALL) = 1 then
         Perform := False;
198

199
200
201
202
      elsif Language = Behavior_Language_Name
        and then Current_Annex_Action (Disable_BA) = 1
      then
         Perform := False;
203

204
205
206
207
      elsif Language = Real_Language_Name
        and then Current_Annex_Action (Disable_REAL) = 1
      then
         Perform := False;
208
209
210
211
212
213

      elsif Language = Error_Language_Name
        and then Current_Annex_Action (Disable_EMA) = 1
      then
         Perform := False;

214
215
216
217
218
219
      end if;

      return Perform;
   end Perform_Annex_Action;

end Ocarina.Options;