OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [a-colire.adb] - Blame information for rev 16

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--             A D A . C O M M A N D _ L I N E . R E M O V E                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1999-2005, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20
-- Boston, MA 02110-1301, USA.                                              --
21
--                                                                          --
22
-- As a special exception,  if other files  instantiate  generics from this --
23
-- unit, or you link  this unit with other files  to produce an executable, --
24
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25
-- covered  by the  GNU  General  Public  License.  This exception does not --
26
-- however invalidate  any other reasons why  the executable file  might be --
27
-- covered by the  GNU Public License.                                      --
28
--                                                                          --
29
-- GNAT was originally developed  by the GNAT team at  New York University. --
30
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31
--                                                                          --
32
------------------------------------------------------------------------------
33
 
34
package body Ada.Command_Line.Remove is
35
 
36
   -----------------------
37
   -- Local Subprograms --
38
   -----------------------
39
 
40
   procedure Initialize;
41
   --  Initialize the Remove_Count and Remove_Args variables
42
 
43
   ----------------
44
   -- Initialize --
45
   ----------------
46
 
47
   procedure Initialize is
48
   begin
49
      if Remove_Args = null then
50
         Remove_Count := Argument_Count;
51
         Remove_Args := new Arg_Nums (1 .. Argument_Count);
52
 
53
         for J in Remove_Args'Range loop
54
            Remove_Args (J) := J;
55
         end loop;
56
      end if;
57
   end Initialize;
58
 
59
   ---------------------
60
   -- Remove_Argument --
61
   ---------------------
62
 
63
   procedure Remove_Argument (Number : in Positive) is
64
   begin
65
      Initialize;
66
 
67
      if Number > Remove_Count then
68
         raise Constraint_Error;
69
      end if;
70
 
71
      Remove_Count := Remove_Count - 1;
72
 
73
      for J in Number .. Remove_Count loop
74
         Remove_Args (J) := Remove_Args (J + 1);
75
      end loop;
76
   end Remove_Argument;
77
 
78
   procedure Remove_Argument (Argument : String) is
79
   begin
80
      for J in reverse 1 .. Argument_Count loop
81
         if Argument = Ada.Command_Line.Argument (J) then
82
            Remove_Argument (J);
83
         end if;
84
      end loop;
85
   end Remove_Argument;
86
 
87
   ----------------------
88
   -- Remove_Arguments --
89
   ----------------------
90
 
91
   procedure Remove_Arguments (From : Positive; To : Natural) is
92
   begin
93
      Initialize;
94
 
95
      if From > Remove_Count
96
        or else To > Remove_Count
97
      then
98
         raise Constraint_Error;
99
      end if;
100
 
101
      if To >= From then
102
         Remove_Count := Remove_Count - (To - From + 1);
103
 
104
         for J in From .. Remove_Count loop
105
            Remove_Args (J) := Remove_Args (J + (To - From + 1));
106
         end loop;
107
      end if;
108
   end Remove_Arguments;
109
 
110
   procedure Remove_Arguments (Argument_Prefix : String) is
111
   begin
112
      for J in reverse 1 .. Argument_Count loop
113
         declare
114
            Arg : constant String := Argument (J);
115
 
116
         begin
117
            if Arg'Length >= Argument_Prefix'Length
118
              and then Arg (1 .. Argument_Prefix'Length) = Argument_Prefix
119
            then
120
               Remove_Argument (J);
121
            end if;
122
         end;
123
      end loop;
124
   end Remove_Arguments;
125
 
126
end Ada.Command_Line.Remove;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.