diff options
Diffstat (limited to 'shell/getopt_r.adb')
| -rw-r--r-- | shell/getopt_r.adb | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/shell/getopt_r.adb b/shell/getopt_r.adb new file mode 100644 index 0000000..22bbdc6 --- /dev/null +++ b/shell/getopt_r.adb @@ -0,0 +1,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; |