← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/adacontrol/jaunty

« back to all changes in this revision

Viewing changes to src/adactl.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-08-24 08:44:11 UTC
  • Revision ID: james.westby@ubuntu.com-20060824084411-1r15uio1h75lqgpx
Tags: upstream-1.4r20
Import upstream version 1.4r20

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/adactl.adb
 
1
----------------------------------------------------------------------
 
2
--  Adactl - Main program body                                      --
 
3
--                                                                  --
 
4
--  This software  is (c) The European Organisation  for the Safety --
 
5
--  of Air  Navigation (EUROCONTROL) and Adalog  2004-2005. The Ada --
 
6
--  Controller  is  free software;  you can redistribute  it and/or --
 
7
--  modify  it under  terms of  the GNU  General Public  License as --
 
8
--  published by the Free Software Foundation; either version 2, or --
 
9
--  (at your  option) any later version.  This  unit is distributed --
 
10
--  in the hope  that it will be useful,  but WITHOUT ANY WARRANTY; --
 
11
--  without even the implied warranty of MERCHANTABILITY or FITNESS --
 
12
--  FOR A  PARTICULAR PURPOSE.  See the GNU  General Public License --
 
13
--  for more details.   You should have received a  copy of the GNU --
 
14
--  General Public License distributed  with this program; see file --
 
15
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
 
16
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
 
17
--                                                                  --
 
18
--  As  a special  exception, if  other files  instantiate generics --
 
19
--  from the units  of this program, or if you  link this unit with --
 
20
--  other files  to produce  an executable, this  unit does  not by --
 
21
--  itself cause the resulting executable  to be covered by the GNU --
 
22
--  General  Public  License.   This  exception  does  not  however --
 
23
--  invalidate any  other reasons why the executable  file might be --
 
24
--  covered by the GNU Public License.                              --
 
25
--                                                                  --
 
26
--  This  software is  distributed  in  the hope  that  it will  be --
 
27
--  useful,  but WITHOUT  ANY  WARRANTY; without  even the  implied --
 
28
--  warranty  of  MERCHANTABILITY   or  FITNESS  FOR  A  PARTICULAR --
 
29
--  PURPOSE.                                                        --
 
30
----------------------------------------------------------------------
 
31
 
 
32
-- Ada
 
33
with
 
34
  Ada.Characters.Handling,
 
35
  Ada.Calendar,
 
36
  Ada.Command_Line,
 
37
  Ada.Exceptions,
 
38
  Ada.Wide_Text_IO;
 
39
 
 
40
-- ASIS
 
41
with
 
42
  Asis.Ada_Environments,
 
43
  Asis.Errors,
 
44
  Asis.Exceptions,
 
45
  Asis.Implementation;
 
46
 
 
47
-- Adalog
 
48
with
 
49
  Utilities,
 
50
  Units_List;
 
51
 
 
52
-- Adactl
 
53
with
 
54
  Adactl_Options,
 
55
  Framework.Language,
 
56
  Framework.Reports,
 
57
  Ruler;
 
58
 
 
59
procedure Adactl is
 
60
   use Ada.Characters.Handling, Ada.Exceptions, Ada.Calendar;
 
61
   use Asis.Exceptions, Asis.Implementation;
 
62
   use Utilities, Adactl_Options;
 
63
 
 
64
   -- Return codes:
 
65
   OK            : constant Ada.Command_Line.Exit_Status :=  0;
 
66
   Checks_Failed : constant Ada.Command_Line.Exit_Status :=  1;
 
67
   Bad_Command   : constant Ada.Command_Line.Exit_Status :=  2;
 
68
   Failure       : constant Ada.Command_Line.Exit_Status := 10;
 
69
 
 
70
   Start_Time : constant Time := Clock;
 
71
 
 
72
   use Framework.Language;
 
73
begin
 
74
 
 
75
   Analyse_Options;
 
76
 
 
77
   if Action /= Help then
 
78
      --
 
79
      -- Init
 
80
      --
 
81
      User_Log ("Loading units, please wait...");
 
82
      Asis.Implementation.Initialize (Initialize_String);
 
83
      Asis.Ada_Environments.Associate (Ruler.My_Context, "Adactl", Asis_Options);
 
84
      Asis.Ada_Environments.Open (Ruler.My_Context);
 
85
      Units_List.Register (Unit_Spec  => Ada_Units_List,
 
86
                           Recursive  => Recursive_Option,
 
87
                           Add_Stubs  => False,
 
88
                           My_Context => Ruler.My_Context);
 
89
   end if;
 
90
 
 
91
   case Action is
 
92
      when Help =>
 
93
         null;           -- Help message printed from Analyse_Options
 
94
 
 
95
      when Dependents =>
 
96
         Execute (Command_Line_Commands);  -- For a possible -o option
 
97
         Units_List.Reset;
 
98
         while not Units_List.Is_Exhausted loop
 
99
            Ada.Wide_Text_IO.Put_Line (Units_List.Current_Unit);
 
100
            Units_List.Skip;
 
101
         end loop;
 
102
 
 
103
      when Process =>
 
104
         Execute (Command_Line_Commands);
 
105
         if not Go_Command_Found then
 
106
            Execute ("Go;");
 
107
         end if;
 
108
 
 
109
      when Interactive_Process =>
 
110
         Execute (Command_Line_Commands);
 
111
         Execute ("source console;");
 
112
 
 
113
   end case;
 
114
 
 
115
   if Action /= Help then
 
116
      -- Close output file if any
 
117
      Execute ("set output console;");
 
118
 
 
119
      --
 
120
      -- Clean up ASIS
 
121
      --
 
122
      Asis.Ada_Environments.Close (Ruler.My_Context);
 
123
      Asis.Ada_Environments.Dissociate (Ruler.My_Context);
 
124
      Asis.Implementation.Finalize;
 
125
 
 
126
      --
 
127
      -- Finalize
 
128
      --
 
129
      if Framework.Language.Had_Failure then
 
130
         Ada.Command_Line.Set_Exit_Status (Failure);
 
131
      elsif Framework.Reports.Error_Reported then
 
132
         Ada.Command_Line.Set_Exit_Status (Checks_Failed);
 
133
      else
 
134
         Ada.Command_Line.Set_Exit_Status (OK);
 
135
      end if;
 
136
 
 
137
      declare
 
138
         Exec_Time_String : constant Wide_String
 
139
           := Integer'Wide_Image (Integer ((Clock - Start_Time)*10));
 
140
      begin
 
141
         User_Log ("Execution_Time: "
 
142
                   & Choose (Exec_Time_String (2 .. Exec_Time_String'Last - 1), "0")
 
143
                   & '.'
 
144
                   & Exec_Time_String (Exec_Time_String'Last)
 
145
                   & "s.");
 
146
      end;
 
147
   end if;
 
148
 
 
149
exception
 
150
   when Occur : Options_Error | Units_List.Specification_Error =>
 
151
      Ada.Command_Line.Set_Exit_Status (Bad_Command);
 
152
      User_Message ("Parameter or option error: " & To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
 
153
      User_Message ("try -h for help");
 
154
 
 
155
   when Occur : Utilities.User_Error =>
 
156
      User_Message ("Error in rule: " & To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
 
157
 
 
158
   when Asis.Exceptions.ASIS_Failed =>
 
159
      case Status is
 
160
         when Asis.Errors.Use_Error =>
 
161
            Ada.Command_Line.Set_Exit_Status (Bad_Command);
 
162
            User_Message (Diagnosis);
 
163
         when others =>
 
164
            Ada.Command_Line.Set_Exit_Status (Failure);
 
165
            raise; -- To get stack trace
 
166
      end case;
 
167
end Adactl;