OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

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

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

powered by: WebSVN 2.1.0

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