111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
4 -- --
|
|
5 -- A D A . S T R I N G S . U N B O U N D E D --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
111
|
10 -- --
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
17 -- --
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
21 -- --
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
26 -- --
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
29 -- --
|
|
30 ------------------------------------------------------------------------------
|
|
31
|
|
32 with Ada.Strings.Fixed;
|
|
33 with Ada.Strings.Search;
|
|
34 with Ada.Unchecked_Deallocation;
|
|
35
|
|
36 package body Ada.Strings.Unbounded is
|
|
37
|
|
38 ---------
|
|
39 -- "&" --
|
|
40 ---------
|
|
41
|
|
42 function "&"
|
|
43 (Left : Unbounded_String;
|
|
44 Right : Unbounded_String) return Unbounded_String
|
|
45 is
|
|
46 L_Length : constant Natural := Left.Last;
|
|
47 R_Length : constant Natural := Right.Last;
|
|
48 Result : Unbounded_String;
|
|
49
|
|
50 begin
|
|
51 Result.Last := L_Length + R_Length;
|
|
52
|
|
53 Result.Reference := new String (1 .. Result.Last);
|
|
54
|
|
55 Result.Reference (1 .. L_Length) :=
|
|
56 Left.Reference (1 .. Left.Last);
|
|
57 Result.Reference (L_Length + 1 .. Result.Last) :=
|
|
58 Right.Reference (1 .. Right.Last);
|
|
59
|
|
60 return Result;
|
|
61 end "&";
|
|
62
|
|
63 function "&"
|
|
64 (Left : Unbounded_String;
|
|
65 Right : String) return Unbounded_String
|
|
66 is
|
|
67 L_Length : constant Natural := Left.Last;
|
|
68 Result : Unbounded_String;
|
|
69
|
|
70 begin
|
|
71 Result.Last := L_Length + Right'Length;
|
|
72
|
|
73 Result.Reference := new String (1 .. Result.Last);
|
|
74
|
|
75 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
|
|
76 Result.Reference (L_Length + 1 .. Result.Last) := Right;
|
|
77
|
|
78 return Result;
|
|
79 end "&";
|
|
80
|
|
81 function "&"
|
|
82 (Left : String;
|
|
83 Right : Unbounded_String) return Unbounded_String
|
|
84 is
|
|
85 R_Length : constant Natural := Right.Last;
|
|
86 Result : Unbounded_String;
|
|
87
|
|
88 begin
|
|
89 Result.Last := Left'Length + R_Length;
|
|
90
|
|
91 Result.Reference := new String (1 .. Result.Last);
|
|
92
|
|
93 Result.Reference (1 .. Left'Length) := Left;
|
|
94 Result.Reference (Left'Length + 1 .. Result.Last) :=
|
|
95 Right.Reference (1 .. Right.Last);
|
|
96
|
|
97 return Result;
|
|
98 end "&";
|
|
99
|
|
100 function "&"
|
|
101 (Left : Unbounded_String;
|
|
102 Right : Character) return Unbounded_String
|
|
103 is
|
|
104 Result : Unbounded_String;
|
|
105
|
|
106 begin
|
|
107 Result.Last := Left.Last + 1;
|
|
108
|
|
109 Result.Reference := new String (1 .. Result.Last);
|
|
110
|
|
111 Result.Reference (1 .. Result.Last - 1) :=
|
|
112 Left.Reference (1 .. Left.Last);
|
|
113 Result.Reference (Result.Last) := Right;
|
|
114
|
|
115 return Result;
|
|
116 end "&";
|
|
117
|
|
118 function "&"
|
|
119 (Left : Character;
|
|
120 Right : Unbounded_String) return Unbounded_String
|
|
121 is
|
|
122 Result : Unbounded_String;
|
|
123
|
|
124 begin
|
|
125 Result.Last := Right.Last + 1;
|
|
126
|
|
127 Result.Reference := new String (1 .. Result.Last);
|
|
128 Result.Reference (1) := Left;
|
|
129 Result.Reference (2 .. Result.Last) :=
|
|
130 Right.Reference (1 .. Right.Last);
|
|
131 return Result;
|
|
132 end "&";
|
|
133
|
|
134 ---------
|
|
135 -- "*" --
|
|
136 ---------
|
|
137
|
|
138 function "*"
|
|
139 (Left : Natural;
|
|
140 Right : Character) return Unbounded_String
|
|
141 is
|
|
142 Result : Unbounded_String;
|
|
143
|
|
144 begin
|
|
145 Result.Last := Left;
|
|
146
|
|
147 Result.Reference := new String (1 .. Left);
|
|
148 for J in Result.Reference'Range loop
|
|
149 Result.Reference (J) := Right;
|
|
150 end loop;
|
|
151
|
|
152 return Result;
|
|
153 end "*";
|
|
154
|
|
155 function "*"
|
|
156 (Left : Natural;
|
|
157 Right : String) return Unbounded_String
|
|
158 is
|
|
159 Len : constant Natural := Right'Length;
|
|
160 K : Positive;
|
|
161 Result : Unbounded_String;
|
|
162
|
|
163 begin
|
|
164 Result.Last := Left * Len;
|
|
165
|
|
166 Result.Reference := new String (1 .. Result.Last);
|
|
167
|
|
168 K := 1;
|
|
169 for J in 1 .. Left loop
|
|
170 Result.Reference (K .. K + Len - 1) := Right;
|
|
171 K := K + Len;
|
|
172 end loop;
|
|
173
|
|
174 return Result;
|
|
175 end "*";
|
|
176
|
|
177 function "*"
|
|
178 (Left : Natural;
|
|
179 Right : Unbounded_String) return Unbounded_String
|
|
180 is
|
|
181 Len : constant Natural := Right.Last;
|
|
182 K : Positive;
|
|
183 Result : Unbounded_String;
|
|
184
|
|
185 begin
|
|
186 Result.Last := Left * Len;
|
|
187
|
|
188 Result.Reference := new String (1 .. Result.Last);
|
|
189
|
|
190 K := 1;
|
|
191 for J in 1 .. Left loop
|
|
192 Result.Reference (K .. K + Len - 1) :=
|
|
193 Right.Reference (1 .. Right.Last);
|
|
194 K := K + Len;
|
|
195 end loop;
|
|
196
|
|
197 return Result;
|
|
198 end "*";
|
|
199
|
|
200 ---------
|
|
201 -- "<" --
|
|
202 ---------
|
|
203
|
|
204 function "<"
|
|
205 (Left : Unbounded_String;
|
|
206 Right : Unbounded_String) return Boolean
|
|
207 is
|
|
208 begin
|
|
209 return
|
|
210 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
|
|
211 end "<";
|
|
212
|
|
213 function "<"
|
|
214 (Left : Unbounded_String;
|
|
215 Right : String) return Boolean
|
|
216 is
|
|
217 begin
|
|
218 return Left.Reference (1 .. Left.Last) < Right;
|
|
219 end "<";
|
|
220
|
|
221 function "<"
|
|
222 (Left : String;
|
|
223 Right : Unbounded_String) return Boolean
|
|
224 is
|
|
225 begin
|
|
226 return Left < Right.Reference (1 .. Right.Last);
|
|
227 end "<";
|
|
228
|
|
229 ----------
|
|
230 -- "<=" --
|
|
231 ----------
|
|
232
|
|
233 function "<="
|
|
234 (Left : Unbounded_String;
|
|
235 Right : Unbounded_String) return Boolean
|
|
236 is
|
|
237 begin
|
|
238 return
|
|
239 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
|
|
240 end "<=";
|
|
241
|
|
242 function "<="
|
|
243 (Left : Unbounded_String;
|
|
244 Right : String) return Boolean
|
|
245 is
|
|
246 begin
|
|
247 return Left.Reference (1 .. Left.Last) <= Right;
|
|
248 end "<=";
|
|
249
|
|
250 function "<="
|
|
251 (Left : String;
|
|
252 Right : Unbounded_String) return Boolean
|
|
253 is
|
|
254 begin
|
|
255 return Left <= Right.Reference (1 .. Right.Last);
|
|
256 end "<=";
|
|
257
|
|
258 ---------
|
|
259 -- "=" --
|
|
260 ---------
|
|
261
|
|
262 function "="
|
|
263 (Left : Unbounded_String;
|
|
264 Right : Unbounded_String) return Boolean
|
|
265 is
|
|
266 begin
|
|
267 return
|
|
268 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
|
|
269 end "=";
|
|
270
|
|
271 function "="
|
|
272 (Left : Unbounded_String;
|
|
273 Right : String) return Boolean
|
|
274 is
|
|
275 begin
|
|
276 return Left.Reference (1 .. Left.Last) = Right;
|
|
277 end "=";
|
|
278
|
|
279 function "="
|
|
280 (Left : String;
|
|
281 Right : Unbounded_String) return Boolean
|
|
282 is
|
|
283 begin
|
|
284 return Left = Right.Reference (1 .. Right.Last);
|
|
285 end "=";
|
|
286
|
|
287 ---------
|
|
288 -- ">" --
|
|
289 ---------
|
|
290
|
|
291 function ">"
|
|
292 (Left : Unbounded_String;
|
|
293 Right : Unbounded_String) return Boolean
|
|
294 is
|
|
295 begin
|
|
296 return
|
|
297 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
|
|
298 end ">";
|
|
299
|
|
300 function ">"
|
|
301 (Left : Unbounded_String;
|
|
302 Right : String) return Boolean
|
|
303 is
|
|
304 begin
|
|
305 return Left.Reference (1 .. Left.Last) > Right;
|
|
306 end ">";
|
|
307
|
|
308 function ">"
|
|
309 (Left : String;
|
|
310 Right : Unbounded_String) return Boolean
|
|
311 is
|
|
312 begin
|
|
313 return Left > Right.Reference (1 .. Right.Last);
|
|
314 end ">";
|
|
315
|
|
316 ----------
|
|
317 -- ">=" --
|
|
318 ----------
|
|
319
|
|
320 function ">="
|
|
321 (Left : Unbounded_String;
|
|
322 Right : Unbounded_String) return Boolean
|
|
323 is
|
|
324 begin
|
|
325 return
|
|
326 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
|
|
327 end ">=";
|
|
328
|
|
329 function ">="
|
|
330 (Left : Unbounded_String;
|
|
331 Right : String) return Boolean
|
|
332 is
|
|
333 begin
|
|
334 return Left.Reference (1 .. Left.Last) >= Right;
|
|
335 end ">=";
|
|
336
|
|
337 function ">="
|
|
338 (Left : String;
|
|
339 Right : Unbounded_String) return Boolean
|
|
340 is
|
|
341 begin
|
|
342 return Left >= Right.Reference (1 .. Right.Last);
|
|
343 end ">=";
|
|
344
|
|
345 ------------
|
|
346 -- Adjust --
|
|
347 ------------
|
|
348
|
|
349 procedure Adjust (Object : in out Unbounded_String) is
|
|
350 begin
|
|
351 -- Copy string, except we do not copy the statically allocated null
|
|
352 -- string since it can never be deallocated. Note that we do not copy
|
|
353 -- extra string room here to avoid dragging unused allocated memory.
|
|
354
|
|
355 if Object.Reference /= Null_String'Access then
|
|
356 Object.Reference := new String'(Object.Reference (1 .. Object.Last));
|
|
357 end if;
|
|
358 end Adjust;
|
|
359
|
|
360 ------------
|
|
361 -- Append --
|
|
362 ------------
|
|
363
|
|
364 procedure Append
|
|
365 (Source : in out Unbounded_String;
|
|
366 New_Item : Unbounded_String)
|
|
367 is
|
|
368 begin
|
|
369 Realloc_For_Chunk (Source, New_Item.Last);
|
|
370 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
|
|
371 New_Item.Reference (1 .. New_Item.Last);
|
|
372 Source.Last := Source.Last + New_Item.Last;
|
|
373 end Append;
|
|
374
|
|
375 procedure Append
|
|
376 (Source : in out Unbounded_String;
|
|
377 New_Item : String)
|
|
378 is
|
|
379 begin
|
|
380 Realloc_For_Chunk (Source, New_Item'Length);
|
|
381 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
|
|
382 New_Item;
|
|
383 Source.Last := Source.Last + New_Item'Length;
|
|
384 end Append;
|
|
385
|
|
386 procedure Append
|
|
387 (Source : in out Unbounded_String;
|
|
388 New_Item : Character)
|
|
389 is
|
|
390 begin
|
|
391 Realloc_For_Chunk (Source, 1);
|
|
392 Source.Reference (Source.Last + 1) := New_Item;
|
|
393 Source.Last := Source.Last + 1;
|
|
394 end Append;
|
|
395
|
|
396 -----------
|
|
397 -- Count --
|
|
398 -----------
|
|
399
|
|
400 function Count
|
|
401 (Source : Unbounded_String;
|
|
402 Pattern : String;
|
|
403 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
404 is
|
|
405 begin
|
|
406 return
|
|
407 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
|
|
408 end Count;
|
|
409
|
|
410 function Count
|
|
411 (Source : Unbounded_String;
|
|
412 Pattern : String;
|
|
413 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
414 is
|
|
415 begin
|
|
416 return
|
|
417 Search.Count (Source.Reference (1 .. Source.Last), Pattern, Mapping);
|
|
418 end Count;
|
|
419
|
|
420 function Count
|
|
421 (Source : Unbounded_String;
|
|
422 Set : Maps.Character_Set) return Natural
|
|
423 is
|
|
424 begin
|
|
425 return Search.Count (Source.Reference (1 .. Source.Last), Set);
|
|
426 end Count;
|
|
427
|
|
428 ------------
|
|
429 -- Delete --
|
|
430 ------------
|
|
431
|
|
432 function Delete
|
|
433 (Source : Unbounded_String;
|
|
434 From : Positive;
|
|
435 Through : Natural) return Unbounded_String
|
|
436 is
|
|
437 begin
|
|
438 return
|
|
439 To_Unbounded_String
|
|
440 (Fixed.Delete (Source.Reference (1 .. Source.Last), From, Through));
|
|
441 end Delete;
|
|
442
|
|
443 procedure Delete
|
|
444 (Source : in out Unbounded_String;
|
|
445 From : Positive;
|
|
446 Through : Natural)
|
|
447 is
|
|
448 begin
|
|
449 if From > Through then
|
|
450 null;
|
|
451
|
|
452 elsif From < Source.Reference'First or else Through > Source.Last then
|
|
453 raise Index_Error;
|
|
454
|
|
455 else
|
|
456 declare
|
|
457 Len : constant Natural := Through - From + 1;
|
|
458
|
|
459 begin
|
|
460 Source.Reference (From .. Source.Last - Len) :=
|
|
461 Source.Reference (Through + 1 .. Source.Last);
|
|
462 Source.Last := Source.Last - Len;
|
|
463 end;
|
|
464 end if;
|
|
465 end Delete;
|
|
466
|
|
467 -------------
|
|
468 -- Element --
|
|
469 -------------
|
|
470
|
|
471 function Element
|
|
472 (Source : Unbounded_String;
|
|
473 Index : Positive) return Character
|
|
474 is
|
|
475 begin
|
|
476 if Index <= Source.Last then
|
|
477 return Source.Reference (Index);
|
|
478 else
|
|
479 raise Strings.Index_Error;
|
|
480 end if;
|
|
481 end Element;
|
|
482
|
|
483 --------------
|
|
484 -- Finalize --
|
|
485 --------------
|
|
486
|
|
487 procedure Finalize (Object : in out Unbounded_String) is
|
|
488 procedure Deallocate is
|
|
489 new Ada.Unchecked_Deallocation (String, String_Access);
|
|
490
|
|
491 begin
|
|
492 -- Note: Don't try to free statically allocated null string
|
|
493
|
|
494 if Object.Reference /= Null_String'Access then
|
|
495 Deallocate (Object.Reference);
|
|
496 Object.Reference := Null_Unbounded_String.Reference;
|
|
497 Object.Last := 0;
|
|
498 end if;
|
|
499 end Finalize;
|
|
500
|
|
501 ----------------
|
|
502 -- Find_Token --
|
|
503 ----------------
|
|
504
|
|
505 procedure Find_Token
|
|
506 (Source : Unbounded_String;
|
|
507 Set : Maps.Character_Set;
|
|
508 From : Positive;
|
|
509 Test : Strings.Membership;
|
|
510 First : out Positive;
|
|
511 Last : out Natural)
|
|
512 is
|
|
513 begin
|
|
514 Search.Find_Token
|
|
515 (Source.Reference (From .. Source.Last), Set, Test, First, Last);
|
|
516 end Find_Token;
|
|
517
|
|
518 procedure Find_Token
|
|
519 (Source : Unbounded_String;
|
|
520 Set : Maps.Character_Set;
|
|
521 Test : Strings.Membership;
|
|
522 First : out Positive;
|
|
523 Last : out Natural)
|
|
524 is
|
|
525 begin
|
|
526 Search.Find_Token
|
|
527 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
|
|
528 end Find_Token;
|
|
529
|
|
530 ----------
|
|
531 -- Free --
|
|
532 ----------
|
|
533
|
|
534 procedure Free (X : in out String_Access) is
|
|
535 procedure Deallocate is
|
|
536 new Ada.Unchecked_Deallocation (String, String_Access);
|
|
537
|
|
538 begin
|
|
539 -- Note: Do not try to free statically allocated null string
|
|
540
|
|
541 if X /= Null_Unbounded_String.Reference then
|
|
542 Deallocate (X);
|
|
543 end if;
|
|
544 end Free;
|
|
545
|
|
546 ----------
|
|
547 -- Head --
|
|
548 ----------
|
|
549
|
|
550 function Head
|
|
551 (Source : Unbounded_String;
|
|
552 Count : Natural;
|
|
553 Pad : Character := Space) return Unbounded_String
|
|
554 is
|
|
555 begin
|
|
556 return To_Unbounded_String
|
|
557 (Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
|
|
558 end Head;
|
|
559
|
|
560 procedure Head
|
|
561 (Source : in out Unbounded_String;
|
|
562 Count : Natural;
|
|
563 Pad : Character := Space)
|
|
564 is
|
|
565 Old : String_Access := Source.Reference;
|
|
566 begin
|
|
567 Source.Reference :=
|
|
568 new String'(Fixed.Head (Source.Reference (1 .. Source.Last),
|
|
569 Count, Pad));
|
|
570 Source.Last := Source.Reference'Length;
|
|
571 Free (Old);
|
|
572 end Head;
|
|
573
|
|
574 -----------
|
|
575 -- Index --
|
|
576 -----------
|
|
577
|
|
578 function Index
|
|
579 (Source : Unbounded_String;
|
|
580 Pattern : String;
|
|
581 Going : Strings.Direction := Strings.Forward;
|
|
582 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
583 is
|
|
584 begin
|
|
585 return Search.Index
|
|
586 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
|
|
587 end Index;
|
|
588
|
|
589 function Index
|
|
590 (Source : Unbounded_String;
|
|
591 Pattern : String;
|
|
592 Going : Direction := Forward;
|
|
593 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
594 is
|
|
595 begin
|
|
596 return Search.Index
|
|
597 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
|
|
598 end Index;
|
|
599
|
|
600 function Index
|
|
601 (Source : Unbounded_String;
|
|
602 Set : Maps.Character_Set;
|
|
603 Test : Strings.Membership := Strings.Inside;
|
|
604 Going : Strings.Direction := Strings.Forward) return Natural
|
|
605 is
|
|
606 begin
|
|
607 return Search.Index
|
|
608 (Source.Reference (1 .. Source.Last), Set, Test, Going);
|
|
609 end Index;
|
|
610
|
|
611 function Index
|
|
612 (Source : Unbounded_String;
|
|
613 Pattern : String;
|
|
614 From : Positive;
|
|
615 Going : Direction := Forward;
|
|
616 Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
|
|
617 is
|
|
618 begin
|
|
619 return Search.Index
|
|
620 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
|
|
621 end Index;
|
|
622
|
|
623 function Index
|
|
624 (Source : Unbounded_String;
|
|
625 Pattern : String;
|
|
626 From : Positive;
|
|
627 Going : Direction := Forward;
|
|
628 Mapping : Maps.Character_Mapping_Function) return Natural
|
|
629 is
|
|
630 begin
|
|
631 return Search.Index
|
|
632 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
|
|
633 end Index;
|
|
634
|
|
635 function Index
|
|
636 (Source : Unbounded_String;
|
|
637 Set : Maps.Character_Set;
|
|
638 From : Positive;
|
|
639 Test : Membership := Inside;
|
|
640 Going : Direction := Forward) return Natural
|
|
641 is
|
|
642 begin
|
|
643 return Search.Index
|
|
644 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
|
|
645 end Index;
|
|
646
|
|
647 function Index_Non_Blank
|
|
648 (Source : Unbounded_String;
|
|
649 Going : Strings.Direction := Strings.Forward) return Natural
|
|
650 is
|
|
651 begin
|
|
652 return
|
|
653 Search.Index_Non_Blank
|
|
654 (Source.Reference (1 .. Source.Last), Going);
|
|
655 end Index_Non_Blank;
|
|
656
|
|
657 function Index_Non_Blank
|
|
658 (Source : Unbounded_String;
|
|
659 From : Positive;
|
|
660 Going : Direction := Forward) return Natural
|
|
661 is
|
|
662 begin
|
|
663 return
|
|
664 Search.Index_Non_Blank
|
|
665 (Source.Reference (1 .. Source.Last), From, Going);
|
|
666 end Index_Non_Blank;
|
|
667
|
|
668 ----------------
|
|
669 -- Initialize --
|
|
670 ----------------
|
|
671
|
|
672 procedure Initialize (Object : in out Unbounded_String) is
|
|
673 begin
|
|
674 Object.Reference := Null_Unbounded_String.Reference;
|
|
675 Object.Last := 0;
|
|
676 end Initialize;
|
|
677
|
|
678 ------------
|
|
679 -- Insert --
|
|
680 ------------
|
|
681
|
|
682 function Insert
|
|
683 (Source : Unbounded_String;
|
|
684 Before : Positive;
|
|
685 New_Item : String) return Unbounded_String
|
|
686 is
|
|
687 begin
|
|
688 return To_Unbounded_String
|
|
689 (Fixed.Insert (Source.Reference (1 .. Source.Last), Before, New_Item));
|
|
690 end Insert;
|
|
691
|
|
692 procedure Insert
|
|
693 (Source : in out Unbounded_String;
|
|
694 Before : Positive;
|
|
695 New_Item : String)
|
|
696 is
|
|
697 begin
|
|
698 if Before not in Source.Reference'First .. Source.Last + 1 then
|
|
699 raise Index_Error;
|
|
700 end if;
|
|
701
|
|
702 Realloc_For_Chunk (Source, New_Item'Length);
|
|
703
|
|
704 Source.Reference
|
|
705 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
|
|
706 Source.Reference (Before .. Source.Last);
|
|
707
|
|
708 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
|
|
709 Source.Last := Source.Last + New_Item'Length;
|
|
710 end Insert;
|
|
711
|
|
712 ------------
|
|
713 -- Length --
|
|
714 ------------
|
|
715
|
|
716 function Length (Source : Unbounded_String) return Natural is
|
|
717 begin
|
|
718 return Source.Last;
|
|
719 end Length;
|
|
720
|
|
721 ---------------
|
|
722 -- Overwrite --
|
|
723 ---------------
|
|
724
|
|
725 function Overwrite
|
|
726 (Source : Unbounded_String;
|
|
727 Position : Positive;
|
|
728 New_Item : String) return Unbounded_String
|
|
729 is
|
|
730 begin
|
|
731 return To_Unbounded_String
|
|
732 (Fixed.Overwrite
|
|
733 (Source.Reference (1 .. Source.Last), Position, New_Item));
|
|
734 end Overwrite;
|
|
735
|
|
736 procedure Overwrite
|
|
737 (Source : in out Unbounded_String;
|
|
738 Position : Positive;
|
|
739 New_Item : String)
|
|
740 is
|
|
741 NL : constant Natural := New_Item'Length;
|
|
742 begin
|
|
743 if Position <= Source.Last - NL + 1 then
|
|
744 Source.Reference (Position .. Position + NL - 1) := New_Item;
|
|
745 else
|
|
746 declare
|
|
747 Old : String_Access := Source.Reference;
|
|
748 begin
|
|
749 Source.Reference := new String'
|
|
750 (Fixed.Overwrite
|
|
751 (Source.Reference (1 .. Source.Last), Position, New_Item));
|
|
752 Source.Last := Source.Reference'Length;
|
|
753 Free (Old);
|
|
754 end;
|
|
755 end if;
|
|
756 end Overwrite;
|
|
757
|
|
758 -----------------------
|
|
759 -- Realloc_For_Chunk --
|
|
760 -----------------------
|
|
761
|
|
762 procedure Realloc_For_Chunk
|
|
763 (Source : in out Unbounded_String;
|
|
764 Chunk_Size : Natural)
|
|
765 is
|
131
|
766 Growth_Factor : constant := 2;
|
111
|
767 -- The growth factor controls how much extra space is allocated when
|
|
768 -- we have to increase the size of an allocated unbounded string. By
|
|
769 -- allocating extra space, we avoid the need to reallocate on every
|
|
770 -- append, particularly important when a string is built up by repeated
|
|
771 -- append operations of small pieces. This is expressed as a factor so
|
131
|
772 -- 2 means add 1/2 of the length of the string as growth space.
|
111
|
773
|
|
774 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
|
|
775 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
|
|
776 -- no memory loss as most (all?) malloc implementations are obliged to
|
|
777 -- align the returned memory on the maximum alignment as malloc does not
|
|
778 -- know the target alignment.
|
|
779
|
|
780 S_Length : constant Natural := Source.Reference'Length;
|
|
781
|
|
782 begin
|
|
783 if Chunk_Size > S_Length - Source.Last then
|
|
784 declare
|
|
785 New_Size : constant Positive :=
|
|
786 S_Length + Chunk_Size + (S_Length / Growth_Factor);
|
|
787
|
|
788 New_Rounded_Up_Size : constant Positive :=
|
|
789 ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
|
|
790
|
|
791 Tmp : constant String_Access :=
|
|
792 new String (1 .. New_Rounded_Up_Size);
|
|
793
|
|
794 begin
|
|
795 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
|
|
796 Free (Source.Reference);
|
|
797 Source.Reference := Tmp;
|
|
798 end;
|
|
799 end if;
|
|
800 end Realloc_For_Chunk;
|
|
801
|
|
802 ---------------------
|
|
803 -- Replace_Element --
|
|
804 ---------------------
|
|
805
|
|
806 procedure Replace_Element
|
|
807 (Source : in out Unbounded_String;
|
|
808 Index : Positive;
|
|
809 By : Character)
|
|
810 is
|
|
811 begin
|
|
812 if Index <= Source.Last then
|
|
813 Source.Reference (Index) := By;
|
|
814 else
|
|
815 raise Strings.Index_Error;
|
|
816 end if;
|
|
817 end Replace_Element;
|
|
818
|
|
819 -------------------
|
|
820 -- Replace_Slice --
|
|
821 -------------------
|
|
822
|
|
823 function Replace_Slice
|
|
824 (Source : Unbounded_String;
|
|
825 Low : Positive;
|
|
826 High : Natural;
|
|
827 By : String) return Unbounded_String
|
|
828 is
|
|
829 begin
|
|
830 return To_Unbounded_String
|
|
831 (Fixed.Replace_Slice
|
|
832 (Source.Reference (1 .. Source.Last), Low, High, By));
|
|
833 end Replace_Slice;
|
|
834
|
|
835 procedure Replace_Slice
|
|
836 (Source : in out Unbounded_String;
|
|
837 Low : Positive;
|
|
838 High : Natural;
|
|
839 By : String)
|
|
840 is
|
|
841 Old : String_Access := Source.Reference;
|
|
842 begin
|
|
843 Source.Reference := new String'
|
|
844 (Fixed.Replace_Slice
|
|
845 (Source.Reference (1 .. Source.Last), Low, High, By));
|
|
846 Source.Last := Source.Reference'Length;
|
|
847 Free (Old);
|
|
848 end Replace_Slice;
|
|
849
|
|
850 --------------------------
|
|
851 -- Set_Unbounded_String --
|
|
852 --------------------------
|
|
853
|
|
854 procedure Set_Unbounded_String
|
|
855 (Target : out Unbounded_String;
|
|
856 Source : String)
|
|
857 is
|
|
858 Old : String_Access := Target.Reference;
|
|
859 begin
|
|
860 Target.Last := Source'Length;
|
|
861 Target.Reference := new String (1 .. Source'Length);
|
|
862 Target.Reference.all := Source;
|
|
863 Free (Old);
|
|
864 end Set_Unbounded_String;
|
|
865
|
|
866 -----------
|
|
867 -- Slice --
|
|
868 -----------
|
|
869
|
|
870 function Slice
|
|
871 (Source : Unbounded_String;
|
|
872 Low : Positive;
|
|
873 High : Natural) return String
|
|
874 is
|
|
875 begin
|
|
876 -- Note: test of High > Length is in accordance with AI95-00128
|
|
877
|
|
878 if Low > Source.Last + 1 or else High > Source.Last then
|
|
879 raise Index_Error;
|
|
880 else
|
|
881 return Source.Reference (Low .. High);
|
|
882 end if;
|
|
883 end Slice;
|
|
884
|
|
885 ----------
|
|
886 -- Tail --
|
|
887 ----------
|
|
888
|
|
889 function Tail
|
|
890 (Source : Unbounded_String;
|
|
891 Count : Natural;
|
|
892 Pad : Character := Space) return Unbounded_String is
|
|
893 begin
|
|
894 return To_Unbounded_String
|
|
895 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
|
|
896 end Tail;
|
|
897
|
|
898 procedure Tail
|
|
899 (Source : in out Unbounded_String;
|
|
900 Count : Natural;
|
|
901 Pad : Character := Space)
|
|
902 is
|
|
903 Old : String_Access := Source.Reference;
|
|
904 begin
|
|
905 Source.Reference := new String'
|
|
906 (Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
|
|
907 Source.Last := Source.Reference'Length;
|
|
908 Free (Old);
|
|
909 end Tail;
|
|
910
|
|
911 ---------------
|
|
912 -- To_String --
|
|
913 ---------------
|
|
914
|
|
915 function To_String (Source : Unbounded_String) return String is
|
|
916 begin
|
|
917 return Source.Reference (1 .. Source.Last);
|
|
918 end To_String;
|
|
919
|
|
920 -------------------------
|
|
921 -- To_Unbounded_String --
|
|
922 -------------------------
|
|
923
|
|
924 function To_Unbounded_String (Source : String) return Unbounded_String is
|
|
925 Result : Unbounded_String;
|
|
926 begin
|
|
927 -- Do not allocate an empty string: keep the default
|
|
928
|
|
929 if Source'Length > 0 then
|
|
930 Result.Last := Source'Length;
|
|
931 Result.Reference := new String (1 .. Source'Length);
|
|
932 Result.Reference.all := Source;
|
|
933 end if;
|
|
934
|
|
935 return Result;
|
|
936 end To_Unbounded_String;
|
|
937
|
|
938 function To_Unbounded_String
|
|
939 (Length : Natural) return Unbounded_String
|
|
940 is
|
|
941 Result : Unbounded_String;
|
|
942
|
|
943 begin
|
|
944 -- Do not allocate an empty string: keep the default
|
|
945
|
|
946 if Length > 0 then
|
|
947 Result.Last := Length;
|
|
948 Result.Reference := new String (1 .. Length);
|
|
949 end if;
|
|
950
|
|
951 return Result;
|
|
952 end To_Unbounded_String;
|
|
953
|
|
954 ---------------
|
|
955 -- Translate --
|
|
956 ---------------
|
|
957
|
|
958 function Translate
|
|
959 (Source : Unbounded_String;
|
|
960 Mapping : Maps.Character_Mapping) return Unbounded_String
|
|
961 is
|
|
962 begin
|
|
963 return To_Unbounded_String
|
|
964 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
|
|
965 end Translate;
|
|
966
|
|
967 procedure Translate
|
|
968 (Source : in out Unbounded_String;
|
|
969 Mapping : Maps.Character_Mapping)
|
|
970 is
|
|
971 begin
|
|
972 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
|
|
973 end Translate;
|
|
974
|
|
975 function Translate
|
|
976 (Source : Unbounded_String;
|
|
977 Mapping : Maps.Character_Mapping_Function) return Unbounded_String
|
|
978 is
|
|
979 begin
|
|
980 return To_Unbounded_String
|
|
981 (Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
|
|
982 end Translate;
|
|
983
|
|
984 procedure Translate
|
|
985 (Source : in out Unbounded_String;
|
|
986 Mapping : Maps.Character_Mapping_Function)
|
|
987 is
|
|
988 begin
|
|
989 Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
|
|
990 end Translate;
|
|
991
|
|
992 ----------
|
|
993 -- Trim --
|
|
994 ----------
|
|
995
|
|
996 function Trim
|
|
997 (Source : Unbounded_String;
|
|
998 Side : Trim_End) return Unbounded_String
|
|
999 is
|
|
1000 begin
|
|
1001 return To_Unbounded_String
|
|
1002 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
|
|
1003 end Trim;
|
|
1004
|
|
1005 procedure Trim
|
|
1006 (Source : in out Unbounded_String;
|
|
1007 Side : Trim_End)
|
|
1008 is
|
|
1009 Old : String_Access := Source.Reference;
|
|
1010 begin
|
|
1011 Source.Reference := new String'
|
|
1012 (Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
|
|
1013 Source.Last := Source.Reference'Length;
|
|
1014 Free (Old);
|
|
1015 end Trim;
|
|
1016
|
|
1017 function Trim
|
|
1018 (Source : Unbounded_String;
|
|
1019 Left : Maps.Character_Set;
|
|
1020 Right : Maps.Character_Set) return Unbounded_String
|
|
1021 is
|
|
1022 begin
|
|
1023 return To_Unbounded_String
|
|
1024 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
|
|
1025 end Trim;
|
|
1026
|
|
1027 procedure Trim
|
|
1028 (Source : in out Unbounded_String;
|
|
1029 Left : Maps.Character_Set;
|
|
1030 Right : Maps.Character_Set)
|
|
1031 is
|
|
1032 Old : String_Access := Source.Reference;
|
|
1033 begin
|
|
1034 Source.Reference := new String'
|
|
1035 (Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
|
|
1036 Source.Last := Source.Reference'Length;
|
|
1037 Free (Old);
|
|
1038 end Trim;
|
|
1039
|
|
1040 ---------------------
|
|
1041 -- Unbounded_Slice --
|
|
1042 ---------------------
|
|
1043
|
|
1044 function Unbounded_Slice
|
|
1045 (Source : Unbounded_String;
|
|
1046 Low : Positive;
|
|
1047 High : Natural) return Unbounded_String
|
|
1048 is
|
|
1049 begin
|
|
1050 if Low > Source.Last + 1 or else High > Source.Last then
|
|
1051 raise Index_Error;
|
|
1052 else
|
|
1053 return To_Unbounded_String (Source.Reference.all (Low .. High));
|
|
1054 end if;
|
|
1055 end Unbounded_Slice;
|
|
1056
|
|
1057 procedure Unbounded_Slice
|
|
1058 (Source : Unbounded_String;
|
|
1059 Target : out Unbounded_String;
|
|
1060 Low : Positive;
|
|
1061 High : Natural)
|
|
1062 is
|
|
1063 begin
|
|
1064 if Low > Source.Last + 1 or else High > Source.Last then
|
|
1065 raise Index_Error;
|
|
1066 else
|
|
1067 Target := To_Unbounded_String (Source.Reference.all (Low .. High));
|
|
1068 end if;
|
|
1069 end Unbounded_Slice;
|
|
1070
|
|
1071 end Ada.Strings.Unbounded;
|