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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-stzfix.adb] - Blame information for rev 717

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--               A D A . S T R I N G S . W I D E _ F I X E D                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2010, 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_Maps; use Ada.Strings.Wide_Wide_Maps;
33
with Ada.Strings.Wide_Wide_Search;
34
 
35
package body Ada.Strings.Wide_Wide_Fixed is
36
 
37
   ------------------------
38
   -- Search Subprograms --
39
   ------------------------
40
 
41
   function Index
42
     (Source  : Wide_Wide_String;
43
      Pattern : Wide_Wide_String;
44
      Going   : Direction := Forward;
45
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
46
                  Wide_Wide_Maps.Identity)
47
      return Natural
48
   renames Ada.Strings.Wide_Wide_Search.Index;
49
 
50
   function Index
51
     (Source  : Wide_Wide_String;
52
      Pattern : Wide_Wide_String;
53
      Going   : Direction := Forward;
54
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
55
      return Natural
56
   renames Ada.Strings.Wide_Wide_Search.Index;
57
 
58
   function Index
59
     (Source : Wide_Wide_String;
60
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
61
      Test   : Membership := Inside;
62
      Going  : Direction  := Forward) return Natural
63
   renames Ada.Strings.Wide_Wide_Search.Index;
64
 
65
   function Index
66
     (Source  : Wide_Wide_String;
67
      Pattern : Wide_Wide_String;
68
      From    : Positive;
69
      Going   : Direction := Forward;
70
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
71
                  Wide_Wide_Maps.Identity)
72
      return Natural
73
   renames Ada.Strings.Wide_Wide_Search.Index;
74
 
75
   function Index
76
     (Source  : Wide_Wide_String;
77
      Pattern : Wide_Wide_String;
78
      From    : Positive;
79
      Going   : Direction := Forward;
80
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
81
      return Natural
82
   renames Ada.Strings.Wide_Wide_Search.Index;
83
 
84
   function Index
85
     (Source  : Wide_Wide_String;
86
      Set     : Wide_Wide_Maps.Wide_Wide_Character_Set;
87
      From    : Positive;
88
      Test    : Membership := Inside;
89
      Going   : Direction := Forward) return Natural
90
   renames Ada.Strings.Wide_Wide_Search.Index;
91
 
92
   function Index_Non_Blank
93
     (Source : Wide_Wide_String;
94
      Going  : Direction := Forward) return Natural
95
      renames Ada.Strings.Wide_Wide_Search.Index_Non_Blank;
96
 
97
   function Index_Non_Blank
98
     (Source : Wide_Wide_String;
99
      From   : Positive;
100
      Going  : Direction := Forward) return Natural
101
   renames Ada.Strings.Wide_Wide_Search.Index_Non_Blank;
102
 
103
   function Count
104
     (Source  : Wide_Wide_String;
105
      Pattern : Wide_Wide_String;
106
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
107
                  Wide_Wide_Maps.Identity)
108
      return Natural
109
   renames Ada.Strings.Wide_Wide_Search.Count;
110
 
111
   function Count
112
     (Source  : Wide_Wide_String;
113
      Pattern : Wide_Wide_String;
114
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
115
      return Natural
116
   renames Ada.Strings.Wide_Wide_Search.Count;
117
 
118
   function Count
119
     (Source : Wide_Wide_String;
120
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
121
   renames Ada.Strings.Wide_Wide_Search.Count;
122
 
123
   procedure Find_Token
124
     (Source : Wide_Wide_String;
125
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
126
      From   : Positive;
127
      Test   : Membership;
128
      First  : out Positive;
129
      Last   : out Natural)
130
   renames Ada.Strings.Wide_Wide_Search.Find_Token;
131
 
132
   procedure Find_Token
133
     (Source : Wide_Wide_String;
134
      Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
135
      Test   : Membership;
136
      First  : out Positive;
137
      Last   : out Natural)
138
   renames Ada.Strings.Wide_Wide_Search.Find_Token;
139
 
140
   ---------
141
   -- "*" --
142
   ---------
143
 
144
   function "*"
145
     (Left  : Natural;
146
      Right : Wide_Wide_Character) return Wide_Wide_String
147
   is
148
      Result : Wide_Wide_String (1 .. Left);
149
 
150
   begin
151
      for J in Result'Range loop
152
         Result (J) := Right;
153
      end loop;
154
 
155
      return Result;
156
   end "*";
157
 
158
   function "*"
159
     (Left  : Natural;
160
      Right : Wide_Wide_String) return Wide_Wide_String
161
   is
162
      Result : Wide_Wide_String (1 .. Left * Right'Length);
163
      Ptr    : Integer := 1;
164
 
165
   begin
166
      for J in 1 .. Left loop
167
         Result (Ptr .. Ptr + Right'Length - 1) := Right;
168
         Ptr := Ptr + Right'Length;
169
      end loop;
170
 
171
      return Result;
172
   end "*";
173
 
174
   ------------
175
   -- Delete --
176
   ------------
177
 
178
   function Delete
179
     (Source  : Wide_Wide_String;
180
      From    : Positive;
181
      Through : Natural) return Wide_Wide_String
182
   is
183
   begin
184
      if From not in Source'Range
185
        or else Through > Source'Last
186
      then
187
         raise Index_Error;
188
 
189
      elsif From > Through then
190
         return Source;
191
 
192
      else
193
         declare
194
            Len    : constant Integer := Source'Length - (Through - From + 1);
195
            Result : constant Wide_Wide_String
196
                       (Source'First .. Source'First + Len - 1) :=
197
                          Source (Source'First .. From - 1) &
198
                          Source (Through + 1 .. Source'Last);
199
         begin
200
            return Result;
201
         end;
202
      end if;
203
   end Delete;
204
 
205
   procedure Delete
206
     (Source  : in out Wide_Wide_String;
207
      From    : Positive;
208
      Through : Natural;
209
      Justify : Alignment := Left;
210
      Pad     : Wide_Wide_Character := Wide_Wide_Space)
211
   is
212
   begin
213
      Move (Source  => Delete (Source, From, Through),
214
            Target  => Source,
215
            Justify => Justify,
216
            Pad     => Pad);
217
   end Delete;
218
 
219
   ----------
220
   -- Head --
221
   ----------
222
 
223
   function Head
224
     (Source : Wide_Wide_String;
225
      Count  : Natural;
226
      Pad    : Wide_Wide_Character := Wide_Wide_Space) return Wide_Wide_String
227
   is
228
      Result : Wide_Wide_String (1 .. Count);
229
 
230
   begin
231
      if Count <= Source'Length then
232
         Result := Source (Source'First .. Source'First + Count - 1);
233
 
234
      else
235
         Result (1 .. Source'Length) := Source;
236
 
237
         for J in Source'Length + 1 .. Count loop
238
            Result (J) := Pad;
239
         end loop;
240
      end if;
241
 
242
      return Result;
243
   end Head;
244
 
245
   procedure Head
246
     (Source  : in out Wide_Wide_String;
247
      Count   : Natural;
248
      Justify : Alignment := Left;
249
      Pad     : Wide_Wide_Character := Ada.Strings.Wide_Wide_Space)
250
   is
251
   begin
252
      Move (Source  => Head (Source, Count, Pad),
253
            Target  => Source,
254
            Drop    => Error,
255
            Justify => Justify,
256
            Pad     => Pad);
257
   end Head;
258
 
259
   ------------
260
   -- Insert --
261
   ------------
262
 
263
   function Insert
264
     (Source   : Wide_Wide_String;
265
      Before   : Positive;
266
      New_Item : Wide_Wide_String) return Wide_Wide_String
267
   is
268
      Result : Wide_Wide_String (1 .. Source'Length + New_Item'Length);
269
 
270
   begin
271
      if Before < Source'First or else Before > Source'Last + 1 then
272
         raise Index_Error;
273
      end if;
274
 
275
      Result := Source (Source'First .. Before - 1) & New_Item &
276
                Source (Before .. Source'Last);
277
      return Result;
278
   end Insert;
279
 
280
   procedure Insert
281
     (Source   : in out Wide_Wide_String;
282
      Before   : Positive;
283
      New_Item : Wide_Wide_String;
284
      Drop     : Truncation := Error)
285
   is
286
   begin
287
      Move (Source => Insert (Source, Before, New_Item),
288
            Target => Source,
289
            Drop   => Drop);
290
   end Insert;
291
 
292
   ----------
293
   -- Move --
294
   ----------
295
 
296
   procedure Move
297
     (Source  : Wide_Wide_String;
298
      Target  : out Wide_Wide_String;
299
      Drop    : Truncation := Error;
300
      Justify : Alignment  := Left;
301
      Pad     : Wide_Wide_Character  := Wide_Wide_Space)
302
   is
303
      Sfirst  : constant Integer := Source'First;
304
      Slast   : constant Integer := Source'Last;
305
      Slength : constant Integer := Source'Length;
306
 
307
      Tfirst  : constant Integer := Target'First;
308
      Tlast   : constant Integer := Target'Last;
309
      Tlength : constant Integer := Target'Length;
310
 
311
      function Is_Padding (Item : Wide_Wide_String) return Boolean;
312
      --  Determinbe if all characters in Item are pad characters
313
 
314
      function Is_Padding (Item : Wide_Wide_String) return Boolean is
315
      begin
316
         for J in Item'Range loop
317
            if Item (J) /= Pad then
318
               return False;
319
            end if;
320
         end loop;
321
 
322
         return True;
323
      end Is_Padding;
324
 
325
   --  Start of processing for Move
326
 
327
   begin
328
      if Slength = Tlength then
329
         Target := Source;
330
 
331
      elsif Slength > Tlength then
332
 
333
         case Drop is
334
            when Left =>
335
               Target := Source (Slast - Tlength + 1 .. Slast);
336
 
337
            when Right =>
338
               Target := Source (Sfirst .. Sfirst + Tlength - 1);
339
 
340
            when Error =>
341
               case Justify is
342
                  when Left =>
343
                     if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
344
                        Target :=
345
                          Source (Sfirst .. Sfirst + Target'Length - 1);
346
                     else
347
                        raise Length_Error;
348
                     end if;
349
 
350
                  when Right =>
351
                     if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
352
                        Target := Source (Slast - Tlength + 1 .. Slast);
353
                     else
354
                        raise Length_Error;
355
                     end if;
356
 
357
                  when Center =>
358
                     raise Length_Error;
359
               end case;
360
 
361
         end case;
362
 
363
      --  Source'Length < Target'Length
364
 
365
      else
366
         case Justify is
367
            when Left =>
368
               Target (Tfirst .. Tfirst + Slength - 1) := Source;
369
 
370
               for J in Tfirst + Slength .. Tlast loop
371
                  Target (J) := Pad;
372
               end loop;
373
 
374
            when Right =>
375
               for J in Tfirst .. Tlast - Slength loop
376
                  Target (J) := Pad;
377
               end loop;
378
 
379
               Target (Tlast - Slength + 1 .. Tlast) := Source;
380
 
381
            when Center =>
382
               declare
383
                  Front_Pad   : constant Integer := (Tlength - Slength) / 2;
384
                  Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
385
 
386
               begin
387
                  for J in Tfirst .. Tfirst_Fpad - 1 loop
388
                     Target (J) := Pad;
389
                  end loop;
390
 
391
                  Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
392
 
393
                  for J in Tfirst_Fpad + Slength .. Tlast loop
394
                     Target (J) := Pad;
395
                  end loop;
396
               end;
397
         end case;
398
      end if;
399
   end Move;
400
 
401
   ---------------
402
   -- Overwrite --
403
   ---------------
404
 
405
   function Overwrite
406
     (Source   : Wide_Wide_String;
407
      Position : Positive;
408
      New_Item : Wide_Wide_String) return Wide_Wide_String
409
   is
410
   begin
411
      if Position not in Source'First .. Source'Last + 1 then
412
         raise Index_Error;
413
      else
414
         declare
415
            Result_Length : constant Natural :=
416
                              Natural'Max
417
                                (Source'Length,
418
                                 Position - Source'First + New_Item'Length);
419
 
420
            Result : Wide_Wide_String (1 .. Result_Length);
421
 
422
         begin
423
            Result := Source (Source'First .. Position - 1) & New_Item &
424
                        Source (Position + New_Item'Length .. Source'Last);
425
            return Result;
426
         end;
427
      end if;
428
   end Overwrite;
429
 
430
   procedure Overwrite
431
     (Source   : in out Wide_Wide_String;
432
      Position : Positive;
433
      New_Item : Wide_Wide_String;
434
      Drop     : Truncation := Right)
435
   is
436
   begin
437
      Move (Source => Overwrite (Source, Position, New_Item),
438
            Target => Source,
439
            Drop   => Drop);
440
   end Overwrite;
441
 
442
   -------------------
443
   -- Replace_Slice --
444
   -------------------
445
 
446
   function Replace_Slice
447
     (Source : Wide_Wide_String;
448
      Low    : Positive;
449
      High   : Natural;
450
      By     : Wide_Wide_String) return Wide_Wide_String
451
   is
452
   begin
453
      if Low > Source'Last + 1 or else High < Source'First - 1 then
454
         raise Index_Error;
455
      end if;
456
 
457
      if High >= Low then
458
         declare
459
            Front_Len : constant Integer :=
460
                          Integer'Max (0, Low - Source'First);
461
            --  Length of prefix of Source copied to result
462
 
463
            Back_Len : constant Integer :=
464
                         Integer'Max (0, Source'Last - High);
465
            --  Length of suffix of Source copied to result
466
 
467
            Result_Length : constant Integer :=
468
                              Front_Len + By'Length + Back_Len;
469
            --  Length of result
470
 
471
            Result : Wide_Wide_String (1 .. Result_Length);
472
 
473
         begin
474
            Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
475
            Result (Front_Len + 1 .. Front_Len + By'Length) := By;
476
            Result (Front_Len + By'Length + 1 .. Result'Length) :=
477
              Source (High + 1 .. Source'Last);
478
            return Result;
479
         end;
480
 
481
      else
482
         return Insert (Source, Before => Low, New_Item => By);
483
      end if;
484
   end Replace_Slice;
485
 
486
   procedure Replace_Slice
487
     (Source   : in out Wide_Wide_String;
488
      Low      : Positive;
489
      High     : Natural;
490
      By       : Wide_Wide_String;
491
      Drop     : Truncation := Error;
492
      Justify  : Alignment  := Left;
493
      Pad      : Wide_Wide_Character  := Wide_Wide_Space)
494
   is
495
   begin
496
      Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
497
   end Replace_Slice;
498
 
499
   ----------
500
   -- Tail --
501
   ----------
502
 
503
   function Tail
504
     (Source : Wide_Wide_String;
505
      Count  : Natural;
506
      Pad    : Wide_Wide_Character := Wide_Wide_Space) return Wide_Wide_String
507
   is
508
      Result : Wide_Wide_String (1 .. Count);
509
 
510
   begin
511
      if Count < Source'Length then
512
         Result := Source (Source'Last - Count + 1 .. Source'Last);
513
 
514
      --  Pad on left
515
 
516
      else
517
         for J in 1 .. Count - Source'Length loop
518
            Result (J) := Pad;
519
         end loop;
520
 
521
         Result (Count - Source'Length + 1 .. Count) := Source;
522
      end if;
523
 
524
      return Result;
525
   end Tail;
526
 
527
   procedure Tail
528
     (Source  : in out Wide_Wide_String;
529
      Count   : Natural;
530
      Justify : Alignment := Left;
531
      Pad     : Wide_Wide_Character := Ada.Strings.Wide_Wide_Space)
532
   is
533
   begin
534
      Move (Source  => Tail (Source, Count, Pad),
535
            Target  => Source,
536
            Drop    => Error,
537
            Justify => Justify,
538
            Pad     => Pad);
539
   end Tail;
540
 
541
   ---------------
542
   -- Translate --
543
   ---------------
544
 
545
   function Translate
546
     (Source  : Wide_Wide_String;
547
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
548
      return Wide_Wide_String
549
   is
550
      Result : Wide_Wide_String (1 .. Source'Length);
551
 
552
   begin
553
      for J in Source'Range loop
554
         Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
555
      end loop;
556
 
557
      return Result;
558
   end Translate;
559
 
560
   procedure Translate
561
     (Source  : in out Wide_Wide_String;
562
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
563
   is
564
   begin
565
      for J in Source'Range loop
566
         Source (J) := Value (Mapping, Source (J));
567
      end loop;
568
   end Translate;
569
 
570
   function Translate
571
     (Source  : Wide_Wide_String;
572
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
573
      return Wide_Wide_String
574
   is
575
      Result : Wide_Wide_String (1 .. Source'Length);
576
 
577
   begin
578
      for J in Source'Range loop
579
         Result (J - (Source'First - 1)) := Mapping (Source (J));
580
      end loop;
581
 
582
      return Result;
583
   end Translate;
584
 
585
   procedure Translate
586
     (Source  : in out Wide_Wide_String;
587
      Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
588
   is
589
   begin
590
      for J in Source'Range loop
591
         Source (J) := Mapping (Source (J));
592
      end loop;
593
   end Translate;
594
 
595
   ----------
596
   -- Trim --
597
   ----------
598
 
599
   function Trim
600
     (Source : Wide_Wide_String;
601
      Side   : Trim_End) return Wide_Wide_String
602
   is
603
      Low  : Natural := Source'First;
604
      High : Natural := Source'Last;
605
 
606
   begin
607
      if Side = Left or else Side = Both then
608
         while Low <= High and then Source (Low) = Wide_Wide_Space loop
609
            Low := Low + 1;
610
         end loop;
611
      end if;
612
 
613
      if Side = Right or else Side = Both then
614
         while High >= Low and then Source (High) = Wide_Wide_Space loop
615
            High := High - 1;
616
         end loop;
617
      end if;
618
 
619
      --  All blanks case
620
 
621
      if Low > High then
622
         return "";
623
 
624
      --  At least one non-blank
625
 
626
      else
627
         declare
628
            Result : constant Wide_Wide_String (1 .. High - Low + 1) :=
629
                       Source (Low .. High);
630
 
631
         begin
632
            return Result;
633
         end;
634
      end if;
635
   end Trim;
636
 
637
   procedure Trim
638
     (Source  : in out Wide_Wide_String;
639
      Side    : Trim_End;
640
      Justify : Alignment      := Left;
641
      Pad     : Wide_Wide_Character := Wide_Wide_Space)
642
   is
643
   begin
644
      Move (Source  => Trim (Source, Side),
645
            Target  => Source,
646
            Justify => Justify,
647
            Pad     => Pad);
648
   end Trim;
649
 
650
   function Trim
651
      (Source : Wide_Wide_String;
652
       Left   : Wide_Wide_Maps.Wide_Wide_Character_Set;
653
       Right  : Wide_Wide_Maps.Wide_Wide_Character_Set) return Wide_Wide_String
654
   is
655
      Low  : Natural := Source'First;
656
      High : Natural := Source'Last;
657
 
658
   begin
659
      while Low <= High and then Is_In (Source (Low), Left) loop
660
         Low := Low + 1;
661
      end loop;
662
 
663
      while High >= Low and then Is_In (Source (High), Right) loop
664
         High := High - 1;
665
      end loop;
666
 
667
      --  Case where source comprises only characters in the sets
668
 
669
      if Low > High then
670
         return "";
671
      else
672
         declare
673
            subtype WS is Wide_Wide_String (1 .. High - Low + 1);
674
 
675
         begin
676
            return WS (Source (Low .. High));
677
         end;
678
      end if;
679
   end Trim;
680
 
681
   procedure Trim
682
      (Source  : in out Wide_Wide_String;
683
       Left    : Wide_Wide_Maps.Wide_Wide_Character_Set;
684
       Right   : Wide_Wide_Maps.Wide_Wide_Character_Set;
685
       Justify : Alignment      := Strings.Left;
686
       Pad     : Wide_Wide_Character := Wide_Wide_Space)
687
   is
688
   begin
689
      Move (Source  => Trim (Source, Left, Right),
690
            Target  => Source,
691
            Justify => Justify,
692
            Pad     => Pad);
693
   end Trim;
694
 
695
end Ada.Strings.Wide_Wide_Fixed;

powered by: WebSVN 2.1.0

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