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