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