OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-stzunb.adb] - Blame information for rev 281

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.