un fonction Command_Line_To_String qui marche pas [résolut]

un fonction Command_Line_To_String qui marche pas [résolut] - Ada - Programmation

Marsh Posté le 21-12-2005 à 15:20:26    

Voila le code :
1:-------------------------------------------------------------------------------
2:--                          Manuel De Girardi 1970 2006                      --
3:--             Laboratoire de recherche en intelligence artificelle          --
4:--
5:--                                                                           --
6:--                                                                           --
7:--                        Ce logiciel est sous Copyleft (C)                  --
8:-------------------------------------------------------------------------------
9:with Text_Io;
10:use Text_Io;
11:with Ada.Strings, Ada.Strings.Fixed;
12:use Ada.Strings, Ada.Strings.Fixed;
13:with Ada.Command_Line;
14:use Ada.Command_Line;
15:procedure Main is
16:   function Length return Positive is
17:      Count : Positive := 1;
18:   begin
19:      Count := Command_Name'Length;
20:      for I in 1..Argument_Count loop
21:         Count := Count + Argument(I)'length + 1;
22:      end loop;
23:      return Count;
24:   end Length;
25:
26:-------------------------------------------------------------------------
27:-- command_line_to_string -----------------------------------------------
28:
29:   function Command_Line_To_String return String is
30:      String_Command_Line : String (1..Length);
31:      K : Positive := Command_Name'Length+1;
32:   begin
33:      String_Command_Line(1..Command_Name'Length) := Command_Name;
34:      for I in 1..Argument_Count loop
35:         String_Command_Line(K) := ' ';
36:         K := K+1;
37:         String_Command_Line(K..K+Argument(I)'length) := Argument(I);
38:         K := K + Argument(I)'Length+1;
39:      end loop;
40:      return String_Command_Line;
41:   end Command_Line_To_String;
42:
43:   -------------------------------------------------------------------------
44:   -------------------------------------------------------------------------
45:
46:   procedure Help is
47:   begin
48:      Put_line(Command_Name & " help : " & Command_Name & " [ Option(s) ]" );
49:      Put_Line("Options :" );
50:      Put_Line("--help                 Affiche l'aide     de " & Command_Name);
51:      Put_Line("--version              Affiche la version de " & Command_Name);
52:   end Help;
53:   procedure version is
54:   begin
55:      Put_line(Command_Name & " version : alpha-0.0.0 20060101" );
56:   end version;
57:begin
58:   if Index(Command_Line_To_String, "--help" ) /= 0 then
59:      Help;return;
60:   end if;
61:   if Index(Command_Line_To_String, "--version" ) /= 0 then
62:      version;return;
63:   end if;
64:end Main;
 
 
A l'execution,
 
raised CONSTRAINT_ERROR : main.adb:37 range check failed
 
J'ai beau relire, je trouve pas l'erreur


Message édité par Profil supprimé le 02-01-2006 à 11:52:03
Reply

Marsh Posté le 21-12-2005 à 15:20:26   

Reply

Marsh Posté le 21-12-2005 à 15:58:10    

Merci, j'ai trouvé l'erreur à la ligne 37,
 
K+Argument(I)'length-1 c'est mieu

Reply

Marsh Posté le 21-12-2005 à 16:01:26    

Non finalement ça marche pas du tout !

Reply

Marsh Posté le 21-12-2005 à 16:47:54    

J'ai changé la procedure, voila le résulat :
 
with Text_Io;
use Text_Io;
with Gnat.Os_Lib;
use Gnat.Os_Lib;
 
with Ada.Strings, Ada.Strings.Fixed;
use Ada.Strings, Ada.Strings.Fixed;
with Ada.Command_Line;
use Ada.Command_Line;
procedure Main is
   function Length return Positive is
      Count : Positive := Command_Name'Length;
   begin
 
      for I in 1..Argument_Count loop
         Count := Count + Argument(I)'length + 1;
      end loop;
      return Count;
   end Length;
 
-------------------------------------------------------------------------
-- command_line_to_string -----------------------------------------------
 
   function Command_Line_To_String return String is
      String_Command_Line : String_Access := new  String ' (" " );
       
   begin
      for I in 1..Argument_count loop
         String_Command_Line := new String ' (Insert(String_Command_Line.all,
                                                     String_Command_Line.all'Length,
                                                    ' ' & Argument(I)));  
         
      end loop;
       
      return String_Command_Line.all;
   end Command_Line_To_String;
 
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------
 
   procedure Help is
   begin
      Put_line(Command_Name & " help : " & Command_Name & " [ Option(s) ]" );
      Put_Line("Options :" );
      Put_Line("--help                 Affiche l'aide     de " & Command_Name);
      Put_Line("--version              Affiche la version de " & Command_Name);
   end Help;
   procedure version is
   begin
      Put_line(Command_Name & " version : alpha-0.0.0 20060101" );
   end version;
begin
   if Index(Command_Line_To_String, "--help" ) /= 0 then
      Help;return;
   end if;
   if Index(Command_Line_To_String, "--version" ) /= 0 then
      version;return;
   end if;
end Main;

Reply

Marsh Posté le 24-12-2005 à 14:56:08    

j'ai mis deux minutes à la dernière lecture pour m'apercevoir des erreurs.
Enfin, le code d'origine corrigé de la fonction "command_line_to_string" :  
 
 -------------------------------------------------------------------------
   -- command_line_to_string -----------------------------------------------
 
   function Command_Line_To_String return String is
      String_Command_Line : String (1..Length);
      K : Positive := Command_Name'Length;
   begin
      String_Command_Line(1..Command_Name'Length) := Command_Name;
      for I in 1..Argument_Count loop
         K := K+1;
         String_Command_Line(K) := ' ';
         String_Command_Line(K..K+Argument(I)'Length-1) := Argument(I);
         K := K + Argument(I)'Length-1;
      end loop;
      return String_Command_Line;
   end Command_Line_To_String;
 
   -------------------------------------------------------------------------
   -------------------------------------------------------------------------

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed