1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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
64
65
66
67
68
69
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
117
118
119
120
121
122
123
124
125
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
--
-- REENTRANT GETOPT
-- BODY
-- $Id$
--
-- Based upon getopt by Nasser Abbasi.
-- modifications to support reentrancy by Joel Sherrill.
--
-- Copyright (C) 1998 Nasser Abbasi <nabbasi@pacbell.net>
-- Copyright (C) 2011 Joel Sherrill <joe.sherrill@oarcorp.com>
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Soft-
-- ware Foundation; either version 2, or (at your option) any later ver-
-- sion. GETOPT is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be
-- covered by the GNU General Public License. This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
--
------------------------------------------------------------------------------
--
-- change history:
--
-- name changes
-- ---------- --------------------------------------------------------------
-- NMA021899 created
-- NMA030299 Changed header to make it modified GPL
--
-- description:
--
-- This package is an Ada implementation of getopt() as specified by the
-- document "The Single UNIX Specification, Version 2", Copyright 1997 The
-- Open Group
--
-- This describes the items involveed using example
--
--
-- curopt
-- |
-- V
-- "-f foo -dbc -k"
-- ^
-- |
-- optind
--
-- optind is position (index) that tells which command line argument is
-- being processed now.
-- curopt tells which optchar is being processed within one command line
-- argument. This is needed only if more that one optchar are stuck
-- togother in one argument with no space, as in -df where both d and f
-- are valid optchar and d takes no optarg.
--
-- Compiler used: GCC 4.5.2 targeting i386-rtems4.10
-- Platform: Fedora 14/x86_64
--
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_Io; use Ada.Text_Io;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Pointers;
with Interfaces.C.Strings; use Interfaces.C.Strings;
package body Getopt_R is
----------------
-- Initialize --
----------------
procedure Initialize (
R : Reentrant_Ptr;
Argc : Argument_Count_Type;
Argv : Argument_Vector_Type
) is
begin
R.Optind := 2;
R.Optopt := ' ';
R.Opterr := 1;
R.Curopt := 2;
R.Argc := Argc;
R.ArgV := Argv;
end Initialize;
------------
-- Getopt --
------------
function Getopt (
R : Reentrant_Ptr;
Optstring : String
) return Integer is
Arg : Unbounded_String;
Arguments : Argument_Array(1 .. R.Argc);
begin
if (R.Argc = 0 or else
R.optind > R.Argc) then
return -1;
end if;
Arguments := Argument_Vector_Package.Value (R.ArgV, R.ArgC);
Arg := To_Unbounded_String (Value(Arguments (R.optind)));
if Element (Arg, 1) /= '-' then
return -1;
end if;
if (Length(Arg) = 1) then
return -1;
end if;
-- according to The Single UNIX Specification, Version 2, if "--"
-- is found, return -1 after ++optind.
if Element (Arg, 2) = '-' then
R.Optind := R.Optind + 1;
return -1;
end if;
-- if we get here, the command argument has "-X"
for I in Optstring'Range loop
Arg := To_Unbounded_String (Value(Arguments (R.optind)));
if (Optstring (I) = Element (Arg, R.Curopt)) then
if (I < Optstring'Length) then
if (Optstring (I + 1) = ':') then
-- see if optarg stuck to optchar
if ( Length (Arg) - R.Curopt > 0) then
R.Optarg := To_Unbounded_String
(Slice (Arg, R.Curopt + 1, Length (Arg)));
R.Curopt := R.Curopt + 1;
R.Optind := R.Optind + 1;
return character'Pos (Optstring (I));
end if;
-- see if optarg on separate argument
if (R.Optind < R.Argc) then
R.Curopt := 2;
R.Optind := R.Optind + 1;
R.Optarg := To_Unbounded_String
(Value (Arguments (R.Optind)));
R.Optind := R.optind + 1;
return character'Pos (Optstring (I));
else
R.Optind := R.Optind + 1;
R.Optopt := Optstring (I);
if (R.Opterr = 1 and
Optstring (Optstring'First) /= ':') then
Put_Line (Standard_Error,
"Argument expected for the -"&
Optstring (I .. I) & " option");
end if;
if (Optstring (Optstring'First) = ':') then
return Character'Pos (':');
else
return Character'Pos ('?');
end if;
end if;
else -- current optchar matches and has no arg option
if (R.Curopt < Length (Arg)) then
R.Curopt := R.Curopt + 1;
else
R.Curopt := 2;
R.Optind := R.Optind + 1;
end if;
return character'Pos (Optstring (I));
end if;
else -- last char in optstring, can't have argument
if (R.Curopt < Length (Arg)) then
R.Curopt := R.Curopt + 1;
else
R.Curopt := 2;
R.Optind := R.Optind + 1;
end if;
return character'Pos (Optstring (I));
end if;
end if;
end loop;
Arg := To_Unbounded_String (Value(Arguments (R.optind)));
R.Optopt := Element (Arg, R.Curopt);
if (R.Curopt < Length (Arg)) then
R.Curopt := R.Curopt + 1;
else
R.Curopt := 2;
R.Optind := R.Optind + 1;
end if;
-- we get here if current command argument not found in optstring
return character'Pos ('?');
end Getopt;
begin
Null;
end Getopt_R;
|
