projects / thirdparty / gcc.git / blame
| Commit | Line | Data |
|---|---|---|
| cacbc350 RK |
1 | ------------------------------------------------------------------------------ |
| 2 | -- -- | |
| 3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
| cacbc350 | 4 | -- -- |
| fbf5a39b | 5 | -- S Y S T E M . C A S E _ U T I L -- |
| cacbc350 | 6 | -- -- |
| fbf5a39b | 7 | -- B o d y -- |
| cacbc350 | 8 | -- -- |
| 4b490c1e | 9 | -- Copyright (C) 1995-2020, AdaCore -- |
| cacbc350 RK |
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- -- | |
| 607d0635 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| cacbc350 RK |
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 -- | |
| 607d0635 AC |
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/>. -- | |
| cacbc350 RK |
26 | -- -- |
| 27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
| 71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| cacbc350 RK |
29 | -- -- |
| 30 | ------------------------------------------------------------------------------ | |
| 31 | ||
| 0355e3eb | 32 | pragma Compiler_Unit_Warning; |
| 2d9ea47f | 33 | |
| fbf5a39b | 34 | package body System.Case_Util is |
| cacbc350 | 35 | |
| fbf5a39b AC |
36 | -------------- |
| 37 | -- To_Lower -- | |
| 38 | -------------- | |
| cacbc350 | 39 | |
| fbf5a39b AC |
40 | function To_Lower (A : Character) return Character is |
| 41 | A_Val : constant Natural := Character'Pos (A); | |
| cacbc350 | 42 | |
| fbf5a39b AC |
43 | begin |
| 44 | if A in 'A' .. 'Z' | |
| 45 | or else A_Val in 16#C0# .. 16#D6# | |
| 46 | or else A_Val in 16#D8# .. 16#DE# | |
| 47 | then | |
| 48 | return Character'Val (A_Val + 16#20#); | |
| 49 | else | |
| 50 | return A; | |
| 51 | end if; | |
| 52 | end To_Lower; | |
| cacbc350 | 53 | |
| fbf5a39b AC |
54 | procedure To_Lower (A : in out String) is |
| 55 | begin | |
| 56 | for J in A'Range loop | |
| 57 | A (J) := To_Lower (A (J)); | |
| 58 | end loop; | |
| 59 | end To_Lower; | |
| cacbc350 | 60 | |
| 9f4b346b BD |
61 | function To_Lower (A : String) return String is |
| 62 | Result : String := A; | |
| 63 | begin | |
| 64 | To_Lower (Result); | |
| 65 | return Result; | |
| 66 | end To_Lower; | |
| 67 | ||
| fbf5a39b AC |
68 | -------------- |
| 69 | -- To_Mixed -- | |
| 70 | -------------- | |
| cacbc350 | 71 | |
| fbf5a39b AC |
72 | procedure To_Mixed (A : in out String) is |
| 73 | Ucase : Boolean := True; | |
| cacbc350 | 74 | |
| fbf5a39b AC |
75 | begin |
| 76 | for J in A'Range loop | |
| 77 | if Ucase then | |
| 78 | A (J) := To_Upper (A (J)); | |
| 79 | else | |
| 80 | A (J) := To_Lower (A (J)); | |
| 81 | end if; | |
| cacbc350 | 82 | |
| fbf5a39b AC |
83 | Ucase := A (J) = '_'; |
| 84 | end loop; | |
| 85 | end To_Mixed; | |
| 86 | ||
| 9f4b346b BD |
87 | function To_Mixed (A : String) return String is |
| 88 | Result : String := A; | |
| 89 | begin | |
| 90 | To_Mixed (Result); | |
| 91 | return Result; | |
| 92 | end To_Mixed; | |
| 93 | ||
| fbf5a39b AC |
94 | -------------- |
| 95 | -- To_Upper -- | |
| 96 | -------------- | |
| 97 | ||
| 98 | function To_Upper (A : Character) return Character is | |
| 99 | A_Val : constant Natural := Character'Pos (A); | |
| 100 | ||
| 101 | begin | |
| 102 | if A in 'a' .. 'z' | |
| 103 | or else A_Val in 16#E0# .. 16#F6# | |
| 104 | or else A_Val in 16#F8# .. 16#FE# | |
| 105 | then | |
| 106 | return Character'Val (A_Val - 16#20#); | |
| 107 | else | |
| 108 | return A; | |
| 109 | end if; | |
| 110 | end To_Upper; | |
| 111 | ||
| 112 | procedure To_Upper (A : in out String) is | |
| 113 | begin | |
| 114 | for J in A'Range loop | |
| 115 | A (J) := To_Upper (A (J)); | |
| 116 | end loop; | |
| 117 | end To_Upper; | |
| 118 | ||
| 9f4b346b BD |
119 | function To_Upper (A : String) return String is |
| 120 | Result : String := A; | |
| 121 | begin | |
| 122 | To_Upper (Result); | |
| 123 | return Result; | |
| 124 | end To_Upper; | |
| 125 | ||
| fbf5a39b | 126 | end System.Case_Util; |