diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/casing.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/casing.adb | 202 |
1 files changed, 0 insertions, 202 deletions
diff --git a/gcc-4.2.1/gcc/ada/casing.adb b/gcc-4.2.1/gcc/ada/casing.adb deleted file mode 100644 index 30db5459d..000000000 --- a/gcc-4.2.1/gcc/ada/casing.adb +++ /dev/null @@ -1,202 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; |