← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/gnat-gps/oneiric

« back to all changes in this revision

Viewing changes to corelib/scripts/src/scripts-utils.adb

  • Committer: Bazaar Package Importer
  • Author(s): Luca Falavigna
  • Date: 2008-08-18 12:35:49 UTC
  • mfrom: (10.1.1 squeeze)
  • Revision ID: james.westby@ubuntu.com-20080818123549-dp25qi8lg9f0x14t
Tags: 4.3~2008.08.09ubuntu1
Add lpia to supported architectures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
corelib/scripts/src/scripts-utils.adb
 
1
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 
2
with Ada.Unchecked_Deallocation;
 
3
with GNAT.OS_Lib;
 
4
with GNAT.Strings;      use GNAT.Strings;
 
5
 
 
6
package body Scripts.Utils is
 
7
 
 
8
   ------------------------------------
 
9
   -- Argument_List_To_Quoted_String --
 
10
   ------------------------------------
 
11
 
 
12
   function Argument_List_To_Quoted_String
 
13
     (Args            : GNAT.Strings.String_List;
 
14
      Quote           : Character := '"';
 
15
      Quote_Backslash : Boolean := True) return String
 
16
   is
 
17
      Len : Natural := 1;
 
18
   begin
 
19
      --  Compute the maximum length of the output.
 
20
 
 
21
      for J in Args'Range loop
 
22
         --  For each argument we append at most 3 characters, two quotes
 
23
         --  plus an ending space.
 
24
 
 
25
         if Args (J) /= null then
 
26
            Len := Len + Args (J)'Length + 3;
 
27
 
 
28
            for T in Args (J)'Range loop
 
29
               if Args (J)(T) = Quote or else Args (J)(T) = '\' then
 
30
                  Len := Len + 1;
 
31
               end if;
 
32
            end loop;
 
33
         end if;
 
34
      end loop;
 
35
 
 
36
      declare
 
37
         Result : String (1 .. Len + 1);
 
38
         Ind    : Natural := Result'First;
 
39
 
 
40
         procedure Append (Str : String);
 
41
         --  Append the contents of Str to Result, protecting quote characters
 
42
 
 
43
         ------------
 
44
         -- Append --
 
45
         ------------
 
46
 
 
47
         procedure Append (Str : String) is
 
48
         begin
 
49
            for J in Str'Range loop
 
50
               if Str (J) = Quote
 
51
                 or else (Quote_Backslash and then Str (J) = '\')
 
52
               then
 
53
                  Result (Ind)     := '\';
 
54
                  Result (Ind + 1) := Str (J);
 
55
                  Ind := Ind + 2;
 
56
               else
 
57
                  Result (Ind) := Str (J);
 
58
                  Ind := Ind + 1;
 
59
               end if;
 
60
            end loop;
 
61
         end Append;
 
62
 
 
63
      begin
 
64
         for J in Args'Range loop
 
65
            if Args (J) /= null then
 
66
               if Index (Args (J).all, " ") > 0 then
 
67
                  Result (Ind) := Quote;
 
68
                  Ind := Ind + 1;
 
69
                  Append (Args (J).all);
 
70
                  Result (Ind) := Quote;
 
71
                  Result (Ind + 1) := ' ';
 
72
                  Ind := Ind + 2;
 
73
 
 
74
               else
 
75
                  Append (Args (J).all);
 
76
                  Result (Ind) := ' ';
 
77
                  Ind := Ind + 1;
 
78
               end if;
 
79
            end if;
 
80
         end loop;
 
81
 
 
82
         return Result (1 .. Ind - 1);
 
83
      end;
 
84
   end Argument_List_To_Quoted_String;
 
85
 
 
86
      ------------------------------------------------
 
87
   -- Argument_String_To_List_With_Triple_Quotes --
 
88
   ------------------------------------------------
 
89
 
 
90
   function Argument_String_To_List_With_Triple_Quotes
 
91
     (Arg_String : String) return String_List_Access
 
92
   is
 
93
      Max_Args : Integer := 128;
 
94
      New_Argv : String_List_Access := new String_List (1 .. Max_Args);
 
95
      New_Argc : Natural := 0;
 
96
      Idx      : Integer;
 
97
 
 
98
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
 
99
        (String_List, String_List_Access);
 
100
      Backslashed       : Boolean;
 
101
      Quoted            : Boolean;
 
102
      Triple_Quoted     : Boolean;
 
103
      Has_Triple        : Boolean;
 
104
      Start_Idx         : Integer;
 
105
      Start_With_Triple : Boolean;
 
106
      End_With_Triple   : Boolean;
 
107
 
 
108
   begin
 
109
      Idx := Arg_String'First;
 
110
 
 
111
      loop
 
112
         exit when Idx > Arg_String'Last;
 
113
 
 
114
         Backslashed   := False;
 
115
         Quoted        := False;
 
116
         Triple_Quoted := False;
 
117
         Start_Idx     := Idx;
 
118
         Start_With_Triple := False;
 
119
         End_With_Triple   := False;
 
120
 
 
121
         while Idx <= Arg_String'Last
 
122
           and then (Backslashed
 
123
                     or else Quoted
 
124
                     or else Triple_Quoted
 
125
                     or else Arg_String (Idx) /= ' ')
 
126
         loop
 
127
            End_With_Triple := False;
 
128
 
 
129
            if Backslashed then
 
130
               Backslashed := False;
 
131
            else
 
132
 
 
133
               case Arg_String (Idx) is
 
134
                  when '\' =>
 
135
                     Backslashed := True;
 
136
 
 
137
                  when '"' =>
 
138
                     if Quoted then
 
139
                        Quoted := False;
 
140
                     else
 
141
                        Has_Triple := Idx + 2 <= Arg_String'Last
 
142
                          and then Arg_String (Idx) = '"'
 
143
                          and then Arg_String (Idx + 1) = '"'
 
144
                          and then Arg_String (Idx + 2) = '"';
 
145
                        if Has_Triple then
 
146
                           Triple_Quoted := not Triple_Quoted;
 
147
                           if Idx = Start_Idx then
 
148
                              Start_With_Triple := Triple_Quoted;
 
149
                           end if;
 
150
                           End_With_Triple := True;
 
151
                           Idx := Idx + 2;
 
152
                        else
 
153
                           Quoted := True;
 
154
                        end if;
 
155
                     end if;
 
156
 
 
157
                  when others =>
 
158
                     null;
 
159
               end case;
 
160
            end if;
 
161
 
 
162
            Idx := Idx + 1;
 
163
         end loop;
 
164
 
 
165
         New_Argc := New_Argc + 1;
 
166
 
 
167
         --  Resize the table if needed
 
168
         if New_Argc > Max_Args then
 
169
            declare
 
170
               New_New_Argv : String_List (1 .. Max_Args * 2);
 
171
            begin
 
172
               New_New_Argv (1 .. Max_Args) := New_Argv.all;
 
173
               Unchecked_Free (New_Argv);
 
174
               New_Argv := new String_List'(New_New_Argv);
 
175
            end;
 
176
 
 
177
            Max_Args := Max_Args * 2;
 
178
         end if;
 
179
 
 
180
         if Start_With_Triple and End_With_Triple then
 
181
            New_Argv (New_Argc) :=
 
182
              new String'(Arg_String (Start_Idx + 3 .. Idx - 4));
 
183
         else
 
184
            New_Argv (New_Argc) :=
 
185
              new String'(Arg_String (Start_Idx .. Idx - 1));
 
186
         end if;
 
187
 
 
188
         --  Skip extraneous spaces
 
189
 
 
190
         while Idx <= Arg_String'Last and then Arg_String (Idx) = ' ' loop
 
191
            Idx := Idx + 1;
 
192
         end loop;
 
193
      end loop;
 
194
 
 
195
      declare
 
196
         Result : constant String_List := New_Argv (1 .. New_Argc);
 
197
      begin
 
198
         Unchecked_Free (New_Argv);
 
199
         return new String_List'(Result);
 
200
      end;
 
201
   end Argument_String_To_List_With_Triple_Quotes;
 
202
 
 
203
   ---------------
 
204
   -- Unprotect --
 
205
   ---------------
 
206
 
 
207
   function Unprotect (Str : String) return String is
 
208
      Result : String (Str'Range);
 
209
      Index  : Natural := Result'First;
 
210
      S      : Natural := Str'First;
 
211
   begin
 
212
      while S <= Str'Last loop
 
213
         if Str (S) = '\' then
 
214
            if S < Str'Last then
 
215
               Result (Index) := Str (S + 1);
 
216
            end if;
 
217
 
 
218
            S := S + 2;
 
219
         else
 
220
            Result (Index) := Str (S);
 
221
            S := S + 1;
 
222
         end if;
 
223
 
 
224
         Index := Index + 1;
 
225
      end loop;
 
226
 
 
227
      return Result (Result'First .. Index - 1);
 
228
   end Unprotect;
 
229
 
 
230
   ---------------
 
231
   -- Read_File --
 
232
   ---------------
 
233
 
 
234
   function Read_File (File : String) return String_Access is
 
235
      use GNAT.OS_Lib;
 
236
      FD           : File_Descriptor := Invalid_FD;
 
237
      Buffer       : GNAT.Strings.String_Access;
 
238
      Length       : Integer;
 
239
      Dummy_Length : Integer;
 
240
      pragma Unreferenced (Dummy_Length);
 
241
 
 
242
   begin
 
243
      FD := Open_Read (File, Fmode => Binary);
 
244
 
 
245
      if FD = Invalid_FD then
 
246
         return null;
 
247
      end if;
 
248
 
 
249
      Length := Integer (File_Length (FD));
 
250
      Buffer := new String (1 .. Length);
 
251
      Dummy_Length := Read (FD, Buffer.all'Address, Length);
 
252
      Close (FD);
 
253
      return Buffer;
 
254
   end Read_File;
 
255
 
 
256
end Scripts.Utils;