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/] [s-strops.adb] - Blame information for rev 523

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


------------------------------------------------------------------------------
--                                                                          --
--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
--                                                                          --
--                    S Y S T E M . S T R I N G _ O P S                     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  NOTE: This package is obsolescent. It is no longer used by the compiler
--  which now generates concatenation inline. It is retained only because
--  it may be used during bootstrapping using old versions of the compiler.
 
pragma Compiler_Unit;
 
package body System.String_Ops is
 
   ----------------
   -- Str_Concat --
   ----------------
 
   function Str_Concat (X, Y : String) return String is
   begin
      if X'Length = 0 then
         return Y;
 
      else
         declare
            L : constant Natural := X'Length + Y'Length;
            R : String (X'First .. X'First + L - 1);
 
         begin
            R (X'Range) := X;
            R (X'First + X'Length .. R'Last) := Y;
            return R;
         end;
      end if;
   end Str_Concat;
 
   -------------------
   -- Str_Concat_CC --
   -------------------
 
   function Str_Concat_CC (X, Y : Character) return String is
      R : String (1 .. 2);
 
   begin
      R (1) := X;
      R (2) := Y;
      return R;
   end Str_Concat_CC;
 
   -------------------
   -- Str_Concat_CS --
   -------------------
 
   function Str_Concat_CS (X : Character; Y : String) return String is
      R : String (1 .. Y'Length + 1);
 
   begin
      R (1) := X;
      R (2 .. R'Last) := Y;
      return R;
   end Str_Concat_CS;
 
   -------------------
   -- Str_Concat_SC --
   -------------------
 
   function Str_Concat_SC (X : String; Y : Character) return String is
   begin
      if X'Length = 0 then
         return (1 => Y);
 
      else
         declare
            R : String (X'First .. X'Last + 1);
 
         begin
            R (X'Range) := X;
            R (R'Last) := Y;
            return R;
         end;
      end if;
   end Str_Concat_SC;
 
end System.String_Ops;

Line No.	Rev	Author	Line
1	281	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --`
4			`-- --`
5			`-- S Y S T E M . S T R I N G _ O P S --`
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 package is obsolescent. It is no longer used by the compiler`
33			`-- which now generates concatenation inline. It is retained only because`
34			`-- it may be used during bootstrapping using old versions of the compiler.`
35
36			`pragma Compiler_Unit;`
37
38			`package body System.String_Ops is`
39
40			`----------------`
41			`-- Str_Concat --`
42			`----------------`
43
44			`function Str_Concat (X, Y : String) return String is`
45			`begin`
46			`if X'Length = 0 then`
47			`return Y;`
48
49			`else`
50			`declare`
51			`L : constant Natural := X'Length + Y'Length;`
52			`R : String (X'First .. X'First + L - 1);`
53
54			`begin`
55			`R (X'Range) := X;`
56			`R (X'First + X'Length .. R'Last) := Y;`
57			`return R;`
58			`end;`
59			`end if;`
60			`end Str_Concat;`
61
62			`-------------------`
63			`-- Str_Concat_CC --`
64			`-------------------`
65
66			`function Str_Concat_CC (X, Y : Character) return String is`
67			`R : String (1 .. 2);`
68
69			`begin`
70			`R (1) := X;`
71			`R (2) := Y;`
72			`return R;`
73			`end Str_Concat_CC;`
74
75			`-------------------`
76			`-- Str_Concat_CS --`
77			`-------------------`
78
79			`function Str_Concat_CS (X : Character; Y : String) return String is`
80			`R : String (1 .. Y'Length + 1);`
81
82			`begin`
83			`R (1) := X;`
84			`R (2 .. R'Last) := Y;`
85			`return R;`
86			`end Str_Concat_CS;`
87
88			`-------------------`
89			`-- Str_Concat_SC --`
90			`-------------------`
91
92			`function Str_Concat_SC (X : String; Y : Character) return String is`
93			`begin`
94			`if X'Length = 0 then`
95			`return (1 => Y);`
96
97			`else`
98			`declare`
99			`R : String (X'First .. X'Last + 1);`
100
101			`begin`
102			`R (X'Range) := X;`
103			`R (R'Last) := Y;`
104			`return R;`
105			`end;`
106			`end if;`
107			`end Str_Concat_SC;`
108
109			`end System.String_Ops;`

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [s-strops.adb] - Blame information for rev 523