← 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-10-12 19:17:22 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20061012191722-fo5bcn4k5r0iubgd
Tags: 1.5r24-1

* New upstream release.
* debian/control (Depends): add gnat-4.1.
  (Enhances): add gnat-gps.
* debian/adacontrol.gpr: build pfni.
* debian/rules: install the new gnat-gps plug-in, and pfni.
* debian/pfni.1: new.
* patches/gps-integration.patch: new.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/adactl.adb
46
46
 
47
47
-- Adalog
48
48
with
 
49
  Thick_Queries,
49
50
  Utilities,
50
51
  Units_List;
51
52
 
54
55
  Adactl_Options,
55
56
  Framework.Language,
56
57
  Framework.Reports,
57
 
  Ruler;
 
58
  Framework.Rules_Manager,
 
59
  Framework.Specific_Plugs;
58
60
 
59
61
procedure Adactl is
60
62
   use Ada.Characters.Handling, Ada.Exceptions, Ada.Calendar;
61
63
   use Asis.Exceptions, Asis.Implementation;
62
64
   use Utilities, Adactl_Options;
63
65
 
 
66
   Version : constant Wide_String := "1.5r24";
 
67
 
64
68
   -- Return codes:
65
69
   OK            : constant Ada.Command_Line.Exit_Status :=  0;
66
70
   Checks_Failed : constant Ada.Command_Line.Exit_Status :=  1;
71
75
 
72
76
   use Framework.Language;
73
77
begin
 
78
   Thick_Queries.Set_Error_Procedure (Utilities.Failure'access);
74
79
 
75
80
   Analyse_Options;
76
81
 
77
 
   if Action /= Help then
 
82
   if Action not in No_Asis_Actions then
78
83
      --
79
84
      -- Init
80
85
      --
81
86
      User_Log ("Loading units, please wait...");
82
87
      Asis.Implementation.Initialize (Initialize_String);
83
 
      Asis.Ada_Environments.Associate (Ruler.My_Context, "Adactl", Asis_Options);
84
 
      Asis.Ada_Environments.Open (Ruler.My_Context);
 
88
      Asis.Ada_Environments.Associate (Framework.Adactl_Context, "Adactl", Asis_Options);
 
89
      Asis.Ada_Environments.Open (Framework.Adactl_Context);
85
90
      Units_List.Register (Unit_Spec  => Ada_Units_List,
86
91
                           Recursive  => Recursive_Option,
87
92
                           Add_Stubs  => False,
88
 
                           My_Context => Ruler.My_Context);
 
93
                           My_Context => Framework.Adactl_Context);
89
94
   end if;
90
95
 
91
96
   case Action is
92
97
      when Help =>
93
 
         null;           -- Help message printed from Analyse_Options
 
98
         Help_Options;
 
99
         User_Message ("Rules:");
 
100
         Framework.Rules_Manager.Help_Names;
 
101
         User_Message ("");
 
102
         User_Message ("ADACTL v. "
 
103
                         & Version
 
104
                         & Choose (Framework.Specific_Plugs.Specific_Version = "",
 
105
                                   "",
 
106
                                   '-' & Framework.Specific_Plugs.Specific_Version)
 
107
                         & ", ASIS version: " & ASIS_Implementor_Version);
 
108
      User_Message ("Copyright (C) 2004-2006 Eurocontrol/Adalog and others.");
 
109
      User_Message ("This software is covered by the GNU Modified General Public License.");
 
110
 
 
111
      when Help_Rule =>
 
112
         Execute (Command_Line_Commands);
94
113
 
95
114
      when Dependents =>
96
115
         Execute (Command_Line_Commands);  -- For a possible -o option
110
129
         Execute (Command_Line_Commands);
111
130
         Execute ("source console;");
112
131
 
 
132
      when Check =>
 
133
         Execute (Command_Line_Commands);
 
134
         -- Note that "Go" commands are not executed when Action=Check
113
135
   end case;
114
136
 
115
137
   if Action /= Help then
119
141
      --
120
142
      -- Clean up ASIS
121
143
      --
122
 
      Asis.Ada_Environments.Close (Ruler.My_Context);
123
 
      Asis.Ada_Environments.Dissociate (Ruler.My_Context);
124
 
      Asis.Implementation.Finalize;
 
144
      if Action > Check then
 
145
         Asis.Ada_Environments.Close (Framework.Adactl_Context);
 
146
         Asis.Ada_Environments.Dissociate (Framework.Adactl_Context);
 
147
         Asis.Implementation.Finalize;
 
148
      end if;
125
149
 
126
150
      --
127
151
      -- Finalize
128
152
      --
129
153
      if Framework.Language.Had_Failure then
130
154
         Ada.Command_Line.Set_Exit_Status (Failure);
131
 
      elsif Framework.Reports.Error_Reported then
 
155
      elsif Framework.Language.Had_Errors then
 
156
         Ada.Command_Line.Set_Exit_Status (Bad_Command);
 
157
      elsif Framework.Reports.Nb_Errors > 0 then
132
158
         Ada.Command_Line.Set_Exit_Status (Checks_Failed);
133
159
      else
134
160
         Ada.Command_Line.Set_Exit_Status (OK);
138
164
         Exec_Time_String : constant Wide_String
139
165
           := Integer'Wide_Image (Integer ((Clock - Start_Time)*10));
140
166
      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.");
 
167
         if Framework.Language.Had_Errors then
 
168
            User_Log ("Syntax errors found");
 
169
         elsif Action = Check then
 
170
            User_Log ("No syntax error");
 
171
         else
 
172
            User_Log ("Total execution time: "
 
173
                      & Choose (Exec_Time_String (2 .. Exec_Time_String'Last - 1), "0")
 
174
                      & '.'
 
175
                      & Exec_Time_String (Exec_Time_String'Last)
 
176
                      & "s.");
 
177
         end if;
146
178
      end;
147
179
   end if;
148
180
 
149
181
exception
150
182
   when Occur : Options_Error | Units_List.Specification_Error =>
151
 
      Ada.Command_Line.Set_Exit_Status (Bad_Command);
152
183
      User_Message ("Parameter or option error: " & To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
153
184
      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)));
 
185
      Ada.Command_Line.Set_Exit_Status (Bad_Command);
157
186
 
158
187
   when Asis.Exceptions.ASIS_Failed =>
159
188
      case Status is
160
189
         when Asis.Errors.Use_Error =>
 
190
            User_Message (Diagnosis);
161
191
            Ada.Command_Line.Set_Exit_Status (Bad_Command);
162
 
            User_Message (Diagnosis);
163
192
         when others =>
164
193
            Ada.Command_Line.Set_Exit_Status (Failure);
165
 
            raise; -- To get stack trace
 
194
            if Exit_Option then
 
195
               -- Unfortunately, GNAT sets the exit status to 1 when terminating on unhandled exception
 
196
               -- Therefore, we reraise the exception (to get stack trace) only with -x option
 
197
               raise;
 
198
            end if;
166
199
      end case;
 
200
 
 
201
   when Occur : Asis.Exceptions.ASIS_Inappropriate_Context
 
202
     | Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit
 
203
     | Asis.Exceptions.ASIS_Inappropriate_Element
 
204
     | Asis.Exceptions.ASIS_Inappropriate_Line
 
205
     | Asis.Exceptions.ASIS_Inappropriate_Line_Number
 
206
     =>
 
207
      -- Presumably, an Adactl error
 
208
      User_Message ("Unexpected ASIS exception at main level ("
 
209
                    & To_Wide_String (Ada.Exceptions.Exception_Name (Occur))
 
210
                    & ") : "
 
211
                    & To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
 
212
      User_Message (Diagnosis);
 
213
      Ada.Command_Line.Set_Exit_Status (Failure);
 
214
      if Exit_Option then
 
215
         -- Unfortunately, GNAT sets the exit status to 1 when terminating on unhandled exception
 
216
         -- Therefore, we reraise the exception (to get stack trace) only with -x option
 
217
         raise;
 
218
      end if;
 
219
 
 
220
   when Occur : others =>
 
221
      User_Message ("Unexpected exception at main level: "
 
222
                    & To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
 
223
      Ada.Command_Line.Set_Exit_Status (Failure);
 
224
      if Exit_Option then
 
225
         -- Unfortunately, GNAT sets the exit status to 1 when terminating on unhandled exception
 
226
         -- Therefore, we reraise the exception (to get stack trace) only with -x option
 
227
         raise;
 
228
      end if;
167
229
end Adactl;