------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- C A S I N G -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2005 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 2, 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. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- -- Boston, MA 02110-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Csets; use Csets; with Namet; use Namet; with Opt; use Opt; with Widechar; use Widechar; package body Casing is ---------------------- -- Determine_Casing -- ---------------------- function Determine_Casing (Ident : Text_Buffer) return Casing_Type is All_Lower : Boolean := True; -- Set False if upper case letter found All_Upper : Boolean := True; -- Set False if lower case letter found Mixed : Boolean := True; -- Set False if exception to mixed case rule found (lower case letter -- at start or after underline, or upper case letter elsewhere). Decisive : Boolean := False; -- Set True if at least one instance of letter not after underline After_Und : Boolean := True; -- True at start of string, and after an underline character begin for S in Ident'Range loop if Ident (S) = '_' or else Ident (S) = '.' then After_Und := True; elsif Is_Lower_Case_Letter (Ident (S)) then All_Upper := False; if not After_Und then Decisive := True; else After_Und := False; Mixed := False; end if; elsif Is_Upper_Case_Letter (Ident (S)) then All_Lower := False; if not After_Und then Decisive := True; Mixed := False; else After_Und := False; end if; end if; end loop; -- Now we can figure out the result from the flags we set in that loop if All_Lower then return All_Lower_Case; elsif not Decisive then return Unknown; elsif All_Upper then return All_Upper_Case; elsif Mixed then return Mixed_Case; else return Unknown; end if; end Determine_Casing; ------------------------ -- Set_All_Upper_Case -- ------------------------ procedure Set_All_Upper_Case is begin Set_Casing (All_Upper_Case); end Set_All_Upper_Case; ---------------- -- Set_Casing -- ---------------- procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case) is Ptr : Natural; Actual_Casing : Casing_Type; -- Set from C or D as appropriate After_Und : Boolean := True; -- True at start of string, and after an underline character or after -- any other special character that is not a normal identifier char). begin if C /= Unknown then Actual_Casing := C; else Actual_Casing := D; end if; Ptr := 1; while Ptr <= Name_Len loop -- Wide character. Note that we do nothing with casing in this case. -- In Ada 2005 mode, required folding of lower case letters happened -- as the identifier was scanned, and we do not attempt any further -- messing with case (note that in any case we do not know how to -- fold upper case to lower case in wide character mode). We also -- do not bother with recognizing punctuation as equivalent to an -- underscore. There is nothing functional at this stage in doing -- the requested casing operation, beyond folding to upper case -- when it is mandatory, which does not involve underscores. if Name_Buffer (Ptr) = ASCII.ESC or else Name_Buffer (Ptr) = '[' or else (Upper_Half_Encoding and then Name_Buffer (Ptr) in Upper_Half_Character) then Skip_Wide (Name_Buffer, Ptr); After_Und := False; -- Underscore, or non-identifer character (error case) elsif Name_Buffer (Ptr) = '_' or else not Identifier_Char (Name_Buffer (Ptr)) then After_Und := True; Ptr := Ptr + 1; -- Lower case letter elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then if Actual_Casing = All_Upper_Case or else (After_Und and then Actual_Casing = Mixed_Case) then Name_Buffer (Ptr) := Fold_Upper (Name_Buffer (Ptr)); end if; After_Und := False; Ptr := Ptr + 1; -- Upper case letter elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then if Actual_Casing = All_Lower_Case or else (not After_Und and then Actual_Casing = Mixed_Case) then Name_Buffer (Ptr) := Fold_Lower (Name_Buffer (Ptr)); end if; After_Und := False; Ptr := Ptr + 1; -- Other identifier character (must be digit) else After_Und := False; Ptr := Ptr + 1; end if; end loop; end Set_Casing; end Casing;