gcc/ada/casing.adb

   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-2005 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Csets;    use Csets;
  35 with Namet;    use Namet;
  36 with Opt;      use Opt;
  37 with Types;    use Types;
  38 with Widechar; use Widechar;
  39
  40 package body Casing is
  41
  42    ----------------------
  43    -- Determine_Casing --
  44    ----------------------
  45
  46    function Determine_Casing (Ident : Text_Buffer) return Casing_Type is
  47
  48       All_Lower : Boolean := True;
  49       --  Set False if upper case letter found
  50
  51       All_Upper : Boolean := True;
  52       --  Set False if lower case letter found
  53
  54       Mixed : Boolean := True;
  55       --  Set False if exception to mixed case rule found (lower case letter
  56       --  at start or after underline, or upper case letter elsewhere).
  57
  58       Decisive : Boolean := False;
  59       --  Set True if at least one instance of letter not after underline
  60
  61       After_Und : Boolean := True;
  62       --  True at start of string, and after an underline character
  63
  64    begin
  65       for S in Ident'Range loop
  66          if Ident (S) = '_' or else Ident (S) = '.' then
  67             After_Und := True;
  68
  69          elsif Is_Lower_Case_Letter (Ident (S)) then
  70             All_Upper := False;
  71
  72             if not After_Und then
  73                Decisive := True;
  74             else
  75                After_Und := False;
  76                Mixed := False;
  77             end if;
  78
  79          elsif Is_Upper_Case_Letter (Ident (S)) then
  80             All_Lower := False;
  81
  82             if not After_Und then
  83                Decisive := True;
  84                Mixed := False;
  85             else
  86                After_Und := False;
  87             end if;
  88          end if;
  89       end loop;
  90
  91       --  Now we can figure out the result from the flags we set in that loop
  92
  93       if All_Lower then
  94          return All_Lower_Case;
  95
  96       elsif not Decisive then
  97          return Unknown;
  98
  99       elsif All_Upper then
 100          return All_Upper_Case;
 101
 102       elsif Mixed then
 103          return Mixed_Case;
 104
 105       else
 106          return Unknown;
 107       end if;
 108    end Determine_Casing;
 109
 110    ------------------------
 111    -- Set_All_Upper_Case --
 112    ------------------------
 113
 114    procedure Set_All_Upper_Case is
 115    begin
 116       Set_Casing (All_Upper_Case);
 117    end Set_All_Upper_Case;
 118
 119    ----------------
 120    -- Set_Casing --
 121    ----------------
 122
 123    procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case) is
 124       Ptr : Natural;
 125
 126       Actual_Casing : Casing_Type;
 127       --  Set from C or D as appropriate
 128
 129       After_Und : Boolean := True;
 130       --  True at start of string, and after an underline character or after
 131       --  any other special character that is not a normal identifier char).
 132
 133    begin
 134       if C /= Unknown then
 135          Actual_Casing := C;
 136       else
 137          Actual_Casing := D;
 138       end if;
 139
 140       Ptr := 1;
 141
 142       while Ptr <= Name_Len loop
 143
 144          --  Wide character. Note that we do nothing with casing in this case.
 145          --  In Ada 2005 mode, required folding of lower case letters happened
 146          --  as the identifier was scanned, and we do not attempt any further
 147          --  messing with case (note that in any case we do not know how to
 148          --  fold upper case to lower case in wide character mode). We also
 149          --  do not bother with recognizing punctuation as equivalent to an
 150          --  underscore. There is nothing functional at this stage in doing
 151          --  the requested casing operation, beyond folding to upper case
 152          --  when it is mandatory, which does not involve underscores.
 153
 154          if Name_Buffer (Ptr) = ASCII.ESC
 155            or else Name_Buffer (Ptr) = '['
 156            or else (Upper_Half_Encoding
 157                      and then Name_Buffer (Ptr) in Upper_Half_Character)
 158          then
 159             Skip_Wide (Name_Buffer, Ptr);
 160             After_Und := False;
 161
 162          --  Underscore, or non-identifer character (error case)
 163
 164          elsif Name_Buffer (Ptr) = '_'
 165             or else not Identifier_Char (Name_Buffer (Ptr))
 166          then
 167             After_Und := True;
 168             Ptr := Ptr + 1;
 169
 170          --  Lower case letter
 171
 172          elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then
 173             if Actual_Casing = All_Upper_Case
 174               or else (After_Und and then Actual_Casing = Mixed_Case)
 175             then
 176                Name_Buffer (Ptr) := Fold_Upper (Name_Buffer (Ptr));
 177             end if;
 178
 179             After_Und := False;
 180             Ptr := Ptr + 1;
 181
 182          --  Upper case letter
 183
 184          elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then
 185             if Actual_Casing = All_Lower_Case
 186               or else (not After_Und and then Actual_Casing = Mixed_Case)
 187             then
 188                Name_Buffer (Ptr) := Fold_Lower (Name_Buffer (Ptr));
 189             end if;
 190
 191             After_Und := False;
 192             Ptr := Ptr + 1;
 193
 194          --  Other identifier character (must be digit)
 195
 196          else
 197             After_Und := False;
 198             Ptr := Ptr + 1;
 199          end if;
 200       end loop;
 201    end Set_Casing;
 202
 203 end Casing;