change log for ada-examples (2011-02-02)
rtems-vc at rtems.org
rtems-vc at rtems.org
Wed Feb 2 19:10:03 UTC 2011
*joel*:
2011-02-02 Joel Sherrill <joel.sherrill at gmail.com>
* commands.adb, commands.ads, rtems_shell.ads, shell.adb: Add getopt_r
Package and example command.
* command_line_arguments.adb, command_line_arguments.ads, getopt_r.adb,
getopt_r.ads: New files.
M 1.4 shell/ChangeLog
A 1.1 shell/command_line_arguments.adb
A 1.1 shell/command_line_arguments.ads
M 1.2 shell/commands.adb
M 1.2 shell/commands.ads
A 1.1 shell/getopt_r.adb
A 1.1 shell/getopt_r.ads
M 1.2 shell/rtems_shell.ads
M 1.2 shell/shell.adb
diff -u ada-examples/shell/ChangeLog:1.3 ada-examples/shell/ChangeLog:1.4
--- ada-examples/shell/ChangeLog:1.3 Thu Sep 17 08:44:02 2009
+++ ada-examples/shell/ChangeLog Wed Feb 2 13:08:05 2011
@@ -1,3 +1,10 @@
+2011-02-02 Joel Sherrill <joel.sherrill at gmail.com>
+
+ * commands.adb, commands.ads, rtems_shell.ads, shell.adb: Add getopt_r
+ Package and example command.
+ * command_line_arguments.adb, command_line_arguments.ads, getopt_r.adb,
+ getopt_r.ads: New files.
+
2009-09-17 Joel Sherrill <joel.sherrill at oarcorp.com>
* .cvsignore: Update or add .cvsignore.
diff -u /dev/null ada-examples/shell/command_line_arguments.adb:1.1
--- /dev/null Wed Feb 2 13:10:02 2011
+++ ada-examples/shell/command_line_arguments.adb Wed Feb 2 13:08:06 2011
@@ -0,0 +1,19 @@
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package body Command_Line_Arguments is
+
+ function Get_Argument(
+ Argv : Argument_Vector_Type;
+ Index : Argument_Count_Type)
+ return String is
+ Arguments : Argument_Array(1 .. Index);
+ begin
+ Arguments := Argument_Vector_Package.Value (ArgV, Index);
+
+ return To_String (To_Unbounded_String (Value(Arguments (Index))));
+ end Get_Argument;
+
+end Command_Line_Arguments;
diff -u /dev/null ada-examples/shell/command_line_arguments.ads:1.1
--- /dev/null Wed Feb 2 13:10:02 2011
+++ ada-examples/shell/command_line_arguments.ads Wed Feb 2 13:08:06 2011
@@ -0,0 +1,25 @@
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package Command_Line_Arguments is
+
+ type Argument_Array is array (ptrdiff_t range <>) of aliased chars_ptr;
+
+ package Argument_Vector_Package is new Pointers (
+ Index => ptrdiff_t,
+ Element => chars_ptr,
+ Element_Array => Argument_Array,
+ Default_Terminator => Null_Ptr
+ );
+
+ subtype Argument_Count_Type is ptrdiff_t;
+ subtype Argument_Vector_Type is Argument_Vector_Package.Pointer;
+
+ function Get_Argument(
+ Argv : in Argument_Vector_Type;
+ Index : Argument_Count_Type
+ ) return String;
+
+end Command_Line_Arguments;
diff -u ada-examples/shell/commands.adb:1.1 ada-examples/shell/commands.adb:1.2
--- ada-examples/shell/commands.adb:1.1 Tue Sep 15 16:11:42 2009
+++ ada-examples/shell/commands.adb Wed Feb 2 13:08:06 2011
@@ -3,6 +3,10 @@
--
with Ada.Text_IO; use Ada.Text_IO;
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Getopt_R;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
package body Commands is
@@ -32,4 +36,52 @@
return 0;
end Command_Test_Arguments;
+ function Command_Getopt_R
+ (ArgC : Argument_Count_Type;
+ ArgV : Argument_Vector_Type)
+ return int is
+ Test_String : String := "c:di:n:p:u:V";
+ Optchar : character;
+ V : Integer;
+ Reent : aliased Getopt_R.Reentrant;
+ begin
+ Getopt_R.Initialize( Reent'Unrestricted_Access, Argc, Argv );
+ loop
+ V := Getopt_R.Getopt( Reent'Unrestricted_Access, Test_String );
+ exit when V = -1;
+
+ optchar := Character'Val( V );
+ case optchar is
+ when 'c' =>
+ Put_Line("command is "& To_String(Reent.Optarg));
+ when 'd' =>
+ Put_Line("debug on");
+ when 'i' =>
+ Put_line("got -i, its argument is:" & To_String(Reent.Optarg) );
+ when 'n' =>
+ Put_line("got -n, its argument is:" & To_String(Reent.Optarg));
+ when 'p' =>
+ Put_line("got -p, its argument is:" & To_String(Reent.Optarg));
+ when 'u' =>
+ Put_line("got -u, its argument is:" & To_String(Reent.Optarg));
+ when 'V' =>
+ Put_line("got -V");
+
+ when '?' =>
+ Put_Line("got ?, optopt is " & Reent.Optopt);
+
+ when ':' =>
+ Put_Line("get :, optopt is "& Reent.optopt);
+
+ when others => null;
+ end case;
+ end loop;
+
+ for Count in Reent.Optind .. Reent.ArgC
+ loop
+ Put_Line (ptrdiff_t'Image(Count) & ": " & Get_Argument(Argv, Count));
+ end loop;
+
+ return 0;
+ end Command_Getopt_R;
end Commands;
diff -u ada-examples/shell/commands.ads:1.1 ada-examples/shell/commands.ads:1.2
--- ada-examples/shell/commands.ads:1.1 Tue Sep 15 16:11:42 2009
+++ ada-examples/shell/commands.ads Wed Feb 2 13:08:06 2011
@@ -2,9 +2,10 @@
-- $Id$
--
-with Interfaces.C; use Interfaces.C;
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with RTEMS_Shell; use RTEMS_Shell;
+with RTEMS_Shell; use RTEMS_Shell;
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
package Commands is
@@ -18,4 +19,10 @@
return int;
pragma Convention (C, Command_Test_Arguments);
+ function Command_Getopt_R
+ (ArgC : Argument_Count_Type;
+ ArgV : Argument_Vector_Type)
+ return int;
+ pragma Convention (C, Command_Getopt_R);
+
end Commands;
diff -u /dev/null ada-examples/shell/getopt_r.adb:1.1
--- /dev/null Wed Feb 2 13:10:02 2011
+++ ada-examples/shell/getopt_r.adb Wed Feb 2 13:08:06 2011
@@ -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 at pacbell.net>
+-- Copyright (C) 2011 Joel Sherrill <joe.sherrill at 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;
diff -u /dev/null ada-examples/shell/getopt_r.ads:1.1
--- /dev/null Wed Feb 2 13:10:02 2011
+++ ada-examples/shell/getopt_r.ads Wed Feb 2 13:08:06 2011
@@ -0,0 +1,96 @@
+--
+-- REENTRANT GETOPT
+-- SPECIFICATION
+-- $Id$
+--
+-- Based upon getopt by Nasser Abbasi.
+-- modifications to support reentrancy by Joel Sherrill.
+--
+-- Copyright (C) 1998 Nasser Abbasi <nabbasi at pacbell.net>
+-- Copyright (C) 2011 Joel Sherrill <joe.sherrill at 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 Command_Line_Arguments; use Command_Line_Arguments;
+
+package Getopt_R is
+
+ pragma Elaborate_Body;
+
+ type Reentrant is
+ record
+ Optind : Argument_Count_type;
+ Optarg : Unbounded_String;
+ Optopt : Character := ' ';
+ Opterr : Integer := 1;
+ Curopt : Natural := 2;
+ Argc : Argument_Count_Type;
+ Argv : Argument_Vector_Type;
+ end record;
+
+ type Reentrant_Ptr is access all Reentrant;
+
+ procedure Initialize (
+ R : Reentrant_Ptr;
+ Argc : Argument_Count_Type;
+ Argv : Argument_Vector_Type);
+
+ function Getopt (
+ R : Reentrant_Ptr;
+ Optstring : String
+ ) return Integer;
+
+end Getopt_R;
diff -u ada-examples/shell/rtems_shell.ads:1.1 ada-examples/shell/rtems_shell.ads:1.2
--- ada-examples/shell/rtems_shell.ads:1.1 Tue Sep 15 16:11:42 2009
+++ ada-examples/shell/rtems_shell.ads Wed Feb 2 13:08:06 2011
@@ -1,43 +1,33 @@
---
--- $Id$
---
-
-with Interfaces.C; use Interfaces.C;
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with Interfaces.C.Pointers;
-
-package RTEMS_Shell is
-
- type Argument_Array is array (ptrdiff_t range <>) of aliased chars_ptr;
-
- package Argument_Vector_Package is
- new Pointers (Index => ptrdiff_t,
- Element => chars_ptr,
- Element_Array => Argument_Array,
- Default_Terminator => Null_Ptr);
-
- subtype Argument_Count_Type is ptrdiff_t;
- subtype Argument_Vector_Type is Argument_Vector_Package.Pointer;
-
- type Command_Function_Type is access function (ArgC : Argument_Count_Type;
- ArgV : Argument_Vector_Type) return int;
- pragma Convention (C, Command_Function_Type);
-
- procedure RTEMS_Shell_Add_Command(Name : chars_ptr; Category : chars_ptr;
- Help : chars_ptr; Command_Function : Command_Function_Type);
- pragma Import (C, RTEMS_Shell_Add_Command, "rtems_shell_add_cmd");
-
- type Prompt_Function_Type is access function return chars_ptr;
- pragma Convention (C, Prompt_Function_Type);
-
- procedure Set_RTEMS_Shell_Prompt_Function(
- Prompt_Function : Prompt_Function_Type);
- pragma Import (C, Set_RTEMS_Shell_Prompt_Function, "set_prompt_function");
-
- procedure Invoke_RTEMS_Shell;
- pragma Import (C, Invoke_RTEMS_Shell, "invoke_rtems_shell");
-
- procedure Initialize_Telnet_Daemon;
- pragma Import (C, Initialize_Telnet_Daemon, "init_telnet_daemon");
-
-end RTEMS_Shell;
+--
+-- $Id$
+--
+
+with Command_Line_Arguments; use Command_Line_Arguments;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Interfaces.C.Pointers;
+
+package RTEMS_Shell is
+
+ type Command_Function_Type is access function (ArgC : Argument_Count_Type;
+ ArgV : Argument_Vector_Type) return int;
+ pragma Convention (C, Command_Function_Type);
+
+ procedure RTEMS_Shell_Add_Command(Name : chars_ptr; Category : chars_ptr;
+ Help : chars_ptr; Command_Function : Command_Function_Type);
+ pragma Import (C, RTEMS_Shell_Add_Command, "rtems_shell_add_cmd");
+
+ type Prompt_Function_Type is access function return chars_ptr;
+ pragma Convention (C, Prompt_Function_Type);
+
+ procedure Set_RTEMS_Shell_Prompt_Function(
+ Prompt_Function : Prompt_Function_Type);
+ pragma Import (C, Set_RTEMS_Shell_Prompt_Function, "set_prompt_function");
+
+ procedure Invoke_RTEMS_Shell;
+ pragma Import (C, Invoke_RTEMS_Shell, "invoke_rtems_shell");
+
+ procedure Initialize_Telnet_Daemon;
+ pragma Import (C, Initialize_Telnet_Daemon, "init_telnet_daemon");
+
+end RTEMS_Shell;
diff -u ada-examples/shell/shell.adb:1.1 ada-examples/shell/shell.adb:1.2
--- ada-examples/shell/shell.adb:1.1 Tue Sep 15 16:16:45 2009
+++ ada-examples/shell/shell.adb Wed Feb 2 13:08:06 2011
@@ -1,21 +1,28 @@
---
--- $Id$
---
-
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with Commands; use Commands;
-with RTEMS_Shell; use RTEMS_Shell;
-
-procedure Main is
-begin
- RTEMS_Shell_Add_Command
- (New_String ("args"),
- New_String ("test"),
- New_String ("Test passing arguments"),
- Command_Test_Arguments'Access);
- Set_RTEMS_Shell_Prompt_Function (C_Prompt'Access);
- Initialize_Telnet_Daemon;
- loop
- Invoke_RTEMS_Shell;
- end loop;
-end Main;
+--
+-- $Id$
+--
+
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+with Commands; use Commands;
+with RTEMS_Shell; use RTEMS_Shell;
+
+procedure Shell is
+begin
+ RTEMS_Shell_Add_Command
+ (New_String ("getopt"),
+ New_String ("test"),
+ New_String ("Example of getopt with pattern c:di:n:p:u:V"),
+ Command_Getopt_R'Access);
+
+ RTEMS_Shell_Add_Command
+ (New_String ("args"),
+ New_String ("test"),
+ New_String ("Test passing arguments"),
+ Command_Test_Arguments'Access);
+
+ Set_RTEMS_Shell_Prompt_Function (C_Prompt'Access);
+ -- Initialize_Telnet_Daemon;
+ loop
+ Invoke_RTEMS_Shell;
+ end loop;
+end Shell;
--
Generated by Deluxe Loginfo [http://www.codewiz.org/projects/index.html#loginfo] 2.122 by Bernardo Innocenti <bernie at develer.com>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.rtems.org/pipermail/vc/attachments/20110202/50d1fdbc/attachment.html>
More information about the vc
mailing list