← Back to branch summary

~ubuntu-branches/ubuntu/maverick/adacontrol/maverick

« back to all changes in this revision

Viewing changes to src/units_list.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-12-06 19:59:00 UTC
  • mfrom: (1.1.2 upstream) (2.1.1 etch)
  • Revision ID: james.westby@ubuntu.com-20061206195900-xnfcv9mmhb22lq95
Tags: 1.6r8-1

* New upstream version.
* debian/rules: add a copyright statement.  Use all available CPUs to
  build.  Install predefined rules files in /usr/share/adacontrol.
* debian/adacontrol.gpr: work around a compiler (GCC 4.1) bug triggered
  by two of AdaControl's source files.
* debian/README.Debian: new; explain about the predefined rule files.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/units_list.adb
48
48
 
49
49
with   -- Reusable components
50
50
  A4G_Bugs,
 
51
  Linear_Queue,
51
52
  Thick_Queries,
52
53
  Utilities;
53
54
package body Units_List is
57
58
   --                 Internal elements                          --
58
59
   ----------------------------------------------------------------
59
60
 
 
61
   package String_List is new Linear_Queue (Wide_String);
 
62
 
60
63
   ------------------
61
64
   -- Global types --
62
65
   ------------------
63
66
 
64
 
   type WS_Access is access Wide_String;
65
 
 
66
67
   type Node;
67
68
   type Link is access Node;
68
69
   type Node (Length : Positive) is
176
177
                       Add_Stubs  : in     Boolean;
177
178
                       My_Context : in out Asis.Context)
178
179
   is
179
 
      use Asis, Asis.Compilation_Units, Asis.Elements, Ada.Strings.Wide_Fixed, Ada.Strings.Wide_Maps;
 
180
      use Asis, Asis.Compilation_Units, Asis.Elements;
 
181
      use Ada.Strings.Wide_Fixed, Ada.Strings.Wide_Maps;
 
182
      use String_List;
180
183
 
181
 
      Ignored_Units : array (1 .. Count (Unit_Spec, "-")    ) of WS_Access;
182
 
      Ignored_Inx   : Natural := 0;
 
184
      Ignored_Units : String_List.Queue;
183
185
      Separators    : constant Wide_Character_Set := To_Set ("+-");
184
186
 
185
 
      procedure Free is new Ada.Unchecked_Deallocation (Wide_String, WS_Access);
186
 
 
187
187
      procedure Raise_Specification_Error (Mess : String) is
188
188
         use Ada.Exceptions;
189
189
      begin
193
193
 
194
194
      function Must_Ignore (Name : Wide_String) return Boolean is
195
195
         -- Check if unit name is either ignored, or a child (or a subunit) of an ignored unit
 
196
        C : String_List.Cursor := First (Ignored_Units);
196
197
      begin
197
 
         for I in Ignored_Units'Range loop
198
 
            if Name = Ignored_Units (I).all or else
199
 
              (Name'Length > Ignored_Units (I).all'Length + 1 and then
200
 
               Ignored_Units (I).all = Name (Name'First .. Name'First+Ignored_Units (I).all'Length-1) and then
201
 
               Name (Name'First + Ignored_Units (I).all'Length) = '.')
202
 
            then
203
 
               return True;
204
 
            end if;
 
198
         while Has_Element (C) loop
 
199
            declare
 
200
               Unit : constant Wide_String := Fetch (C);
 
201
            begin
 
202
               if Name = Unit
 
203
                 or else (Name'Length > Unit'Length + 1
 
204
                   and then Unit = Name (Name'First .. Name'First+Unit'Length-1)
 
205
                          and then Name (Name'First + Unit'Length) = '.')
 
206
               then
 
207
                  return True;
 
208
               end if;
 
209
            end;
 
210
            C := Next (C);
205
211
         end loop;
206
212
         return False;
207
213
      end Must_Ignore;
232
238
               end if;
233
239
            end;
234
240
         end Add_Withed_Unit;
235
 
      begin
 
241
      begin   -- Do_Process_With
236
242
         if Is_Nil (My_Unit) then
237
243
            return;
238
244
         end if;
287
293
         use Ada.Characters.Handling;
288
294
 
289
295
         procedure Process_Indirect_File (Name : String) is
290
 
            use Ada.Wide_Text_IO, Ada.Strings;
 
296
            use Ada.Wide_Text_IO;
291
297
 
292
298
            Units_File : Ada.Wide_Text_IO.File_Type;
293
299
 
309
315
            -- This is the simplest way to deal with improperly formed files
310
316
            loop
311
317
               declare
312
 
                  Line : constant Wide_String := Trim (Read_Line, Both);
 
318
                  Line : constant Wide_String := Trim_All (Read_Line);
313
319
               begin
314
 
                  if Line /= "" and then Line (1) /= '#' then
 
320
                  if Line /= "" and then Line (1) /= '#' and then (Line'Length = 1 or else Line (1..2) /= "--") then
315
321
                     Process_Unit_Spec (Line);
316
322
                  end if;
317
323
               end;
323
329
               Raise_Specification_Error ("Missing units file: " & Name);
324
330
            when others =>  -- Including End_Error
325
331
               if Is_Open (Units_File) then
326
 
               Close (Units_File);
 
332
                  Close (Units_File);
327
333
               end if;
328
334
         end Process_Indirect_File;
329
335
 
347
353
         -- Extract unit names and ignored units from unit spec.
348
354
         --
349
355
 
350
 
         -- If Spec starts with '-', our count is wrong...
351
 
         -- let's forbid this case
352
 
         if Spec (Spec'First) = '-' then
353
 
            Raise_Specification_Error ("Wrong unit specification: " & To_String (Spec));
354
 
         end if;
355
 
 
356
356
         if Spec (Spec'First) = '+' then
357
357
            Start := Spec'First + 1;
358
358
         else
370
370
            if Start = Spec'First or else Spec (Start-1) = '+' then
371
371
               Add (To_Upper(Spec (Start .. Stop)));
372
372
            else
373
 
               Ignored_Inx                 := Ignored_Inx + 1;
374
 
               Ignored_Units (Ignored_Inx) := new Wide_String'(To_Upper(Spec (Start .. Stop)));
 
373
               Append (Ignored_Units, To_Upper(Spec (Start .. Stop)));
375
374
            end if;
376
375
            exit when Stop = Spec'Last;
377
376
            Start := Stop + 2;
414
413
            end if;
415
414
         end;
416
415
      end loop;
417
 
 
418
 
      for I in Ignored_Units'Range loop
419
 
         Free (Ignored_Units (I));
420
 
      end loop;
421
416
   end Register;
422
417
 
423
418
   -----------