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;