1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- C A S I N G -- 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 32with Csets; use Csets; 33with Namet; use Namet; 34with Opt; use Opt; 35with Widechar; use Widechar; 36 37package body Casing is 38 39 ---------------------- 40 -- Determine_Casing -- 41 ---------------------- 42 43 function Determine_Casing (Ident : Text_Buffer) return Casing_Type is 44 45 All_Lower : Boolean := True; 46 -- Set False if upper case letter found 47 48 All_Upper : Boolean := True; 49 -- Set False if lower case letter found 50 51 Mixed : Boolean := True; 52 -- Set False if exception to mixed case rule found (lower case letter 53 -- at start or after underline, or upper case letter elsewhere). 54 55 Decisive : Boolean := False; 56 -- Set True if at least one instance of letter not after underline 57 58 After_Und : Boolean := True; 59 -- True at start of string, and after an underline character 60 61 begin 62 for S in Ident'Range loop 63 if Ident (S) = '_' or else Ident (S) = '.' then 64 After_Und := True; 65 66 elsif Is_Lower_Case_Letter (Ident (S)) then 67 All_Upper := False; 68 69 if not After_Und then 70 Decisive := True; 71 else 72 After_Und := False; 73 Mixed := False; 74 end if; 75 76 elsif Is_Upper_Case_Letter (Ident (S)) then 77 All_Lower := False; 78 79 if not After_Und then 80 Decisive := True; 81 Mixed := False; 82 else 83 After_Und := False; 84 end if; 85 end if; 86 end loop; 87 88 -- Now we can figure out the result from the flags we set in that loop 89 90 if All_Lower then 91 return All_Lower_Case; 92 93 elsif not Decisive then 94 return Unknown; 95 96 elsif All_Upper then 97 return All_Upper_Case; 98 99 elsif Mixed then 100 return Mixed_Case; 101 102 else 103 return Unknown; 104 end if; 105 end Determine_Casing; 106 107 ------------------------ 108 -- Set_All_Upper_Case -- 109 ------------------------ 110 111 procedure Set_All_Upper_Case is 112 begin 113 Set_Casing (All_Upper_Case); 114 end Set_All_Upper_Case; 115 116 ---------------- 117 -- Set_Casing -- 118 ---------------- 119 120 procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case) is 121 Ptr : Natural; 122 123 Actual_Casing : Casing_Type; 124 -- Set from C or D as appropriate 125 126 After_Und : Boolean := True; 127 -- True at start of string, and after an underline character or after 128 -- any other special character that is not a normal identifier char). 129 130 begin 131 if C /= Unknown then 132 Actual_Casing := C; 133 else 134 Actual_Casing := D; 135 end if; 136 137 Ptr := 1; 138 139 while Ptr <= Name_Len loop 140 141 -- Wide character. Note that we do nothing with casing in this case. 142 -- In Ada 2005 mode, required folding of lower case letters happened 143 -- as the identifier was scanned, and we do not attempt any further 144 -- messing with case (note that in any case we do not know how to 145 -- fold upper case to lower case in wide character mode). We also 146 -- do not bother with recognizing punctuation as equivalent to an 147 -- underscore. There is nothing functional at this stage in doing 148 -- the requested casing operation, beyond folding to upper case 149 -- when it is mandatory, which does not involve underscores. 150 151 if Name_Buffer (Ptr) = ASCII.ESC 152 or else Name_Buffer (Ptr) = '[' 153 or else (Upper_Half_Encoding 154 and then Name_Buffer (Ptr) in Upper_Half_Character) 155 then 156 Skip_Wide (Name_Buffer, Ptr); 157 After_Und := False; 158 159 -- Underscore, or non-identifer character (error case) 160 161 elsif Name_Buffer (Ptr) = '_' 162 or else not Identifier_Char (Name_Buffer (Ptr)) 163 then 164 After_Und := True; 165 Ptr := Ptr + 1; 166 167 -- Lower case letter 168 169 elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then 170 if Actual_Casing = All_Upper_Case 171 or else (After_Und and then Actual_Casing = Mixed_Case) 172 then 173 Name_Buffer (Ptr) := Fold_Upper (Name_Buffer (Ptr)); 174 end if; 175 176 After_Und := False; 177 Ptr := Ptr + 1; 178 179 -- Upper case letter 180 181 elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then 182 if Actual_Casing = All_Lower_Case 183 or else (not After_Und and then Actual_Casing = Mixed_Case) 184 then 185 Name_Buffer (Ptr) := Fold_Lower (Name_Buffer (Ptr)); 186 end if; 187 188 After_Und := False; 189 Ptr := Ptr + 1; 190 191 -- Other identifier character (must be digit) 192 193 else 194 After_Und := False; 195 Ptr := Ptr + 1; 196 end if; 197 end loop; 198 end Set_Casing; 199 200end Casing; 201