1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Einfo; use Einfo;
29 with Errout; use Errout;
30 with Namet; use Namet;
31 with Nlists; use Nlists;
32 with Nmake; use Nmake;
35 with Sem_Eval; use Sem_Eval;
36 with Sem_Res; use Sem_Res;
37 with Sem_Util; use Sem_Util;
38 with Sem_Type; use Sem_Type;
39 with Snames; use Snames;
40 with Stand; use Stand;
41 with Sinfo; use Sinfo;
42 with Tbuild; use Tbuild;
43 with Uintp; use Uintp;
45 with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
47 package body Sem_Case is
49 -----------------------
50 -- Local Subprograms --
51 -----------------------
53 type Sort_Choice_Table_Type is array (Nat range <>) of Choice_Bounds;
54 -- This new array type is used as the actual table type for sorting
55 -- discrete choices. The reason for not using Choice_Table_Type, is that
56 -- in Sort_Choice_Table_Type we reserve entry 0 for the sorting algortim
57 -- (this is not absolutely necessary but it makes the code more
60 procedure Check_Choices
61 (Choice_Table : in out Sort_Choice_Table_Type;
62 Bounds_Type : Entity_Id;
63 Others_Present : Boolean;
64 Msg_Sloc : Source_Ptr);
65 -- This is the procedure which verifies that a set of case alternatives
66 -- or record variant choices has no duplicates, and covers the range
67 -- specified by Bounds_Type. Choice_Table contains the discrete choices
68 -- to check. These must start at position 1.
69 -- Furthermore Choice_Table (0) must exist. This element is used by
70 -- the sorting algorithm as a temporary. Others_Present is a flag
71 -- indicating whether or not an Others choice is present. Finally
72 -- Msg_Sloc gives the source location of the construct containing the
73 -- choices in the Choice_Table.
75 function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id;
76 -- Given a Pos value of enumeration type Ctype, returns the name
77 -- ID of an appropriate string to be used in error message output.
79 procedure Expand_Others_Choice
80 (Case_Table : Choice_Table_Type;
81 Others_Choice : Node_Id;
82 Choice_Type : Entity_Id);
83 -- The case table is the table generated by a call to Analyze_Choices
84 -- (with just 1 .. Last_Choice entries present). Others_Choice is a
85 -- pointer to the N_Others_Choice node (this routine is only called if
86 -- an others choice is present), and Choice_Type is the discrete type
87 -- of the bounds. The effect of this call is to analyze the cases and
88 -- determine the set of values covered by others. This choice list is
89 -- set in the Others_Discrete_Choices field of the N_Others_Choice node.
95 procedure Check_Choices
96 (Choice_Table : in out Sort_Choice_Table_Type;
97 Bounds_Type : Entity_Id;
98 Others_Present : Boolean;
99 Msg_Sloc : Source_Ptr)
101 function Lt_Choice (C1, C2 : Natural) return Boolean;
102 -- Comparison routine for comparing Choice_Table entries.
103 -- Use the lower bound of each Choice as the key.
105 procedure Move_Choice (From : Natural; To : Natural);
106 -- Move routine for sorting the Choice_Table.
108 procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
109 procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
110 procedure Issue_Msg (Value1 : Uint; Value2 : Node_Id);
111 procedure Issue_Msg (Value1 : Uint; Value2 : Uint);
112 -- Issue an error message indicating that there are missing choices,
113 -- followed by the image of the missing choices themselves which lie
114 -- between Value1 and Value2 inclusive.
120 procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id) is
122 Issue_Msg (Expr_Value (Value1), Expr_Value (Value2));
125 procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint) is
127 Issue_Msg (Expr_Value (Value1), Value2);
130 procedure Issue_Msg (Value1 : Uint; Value2 : Node_Id) is
132 Issue_Msg (Value1, Expr_Value (Value2));
135 procedure Issue_Msg (Value1 : Uint; Value2 : Uint) is
137 -- In some situations, we call this with a null range, and
138 -- obviously we don't want to complain in this case!
140 if Value1 > Value2 then
144 -- Case of only one value that is missing
146 if Value1 = Value2 then
147 if Is_Integer_Type (Bounds_Type) then
148 Error_Msg_Uint_1 := Value1;
149 Error_Msg ("missing case value: ^!", Msg_Sloc);
151 Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
152 Error_Msg ("missing case value: %!", Msg_Sloc);
155 -- More than one choice value, so print range of values
158 if Is_Integer_Type (Bounds_Type) then
159 Error_Msg_Uint_1 := Value1;
160 Error_Msg_Uint_2 := Value2;
161 Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
163 Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
164 Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
165 Error_Msg ("missing case values: % .. %!", Msg_Sloc);
174 function Lt_Choice (C1, C2 : Natural) return Boolean is
177 Expr_Value (Choice_Table (Nat (C1)).Lo)
179 Expr_Value (Choice_Table (Nat (C2)).Lo);
186 procedure Move_Choice (From : Natural; To : Natural) is
188 Choice_Table (Nat (To)) := Choice_Table (Nat (From));
191 -- Variables local to Check_Choices
194 Bounds_Lo : constant Node_Id := Type_Low_Bound (Bounds_Type);
195 Bounds_Hi : constant Node_Id := Type_High_Bound (Bounds_Type);
197 Prev_Choice : Node_Id;
203 -- Start processing for Check_Choices
206 -- Choice_Table must start at 0 which is an unused location used
207 -- by the sorting algorithm. However the first valid position for
208 -- a discrete choice is 1.
210 pragma Assert (Choice_Table'First = 0);
212 if Choice_Table'Last = 0 then
213 if not Others_Present then
214 Issue_Msg (Bounds_Lo, Bounds_Hi);
220 (Positive (Choice_Table'Last),
221 Move_Choice'Unrestricted_Access,
222 Lt_Choice'Unrestricted_Access);
224 Lo := Expr_Value (Choice_Table (1).Lo);
225 Hi := Expr_Value (Choice_Table (1).Hi);
228 if not Others_Present and then Expr_Value (Bounds_Lo) < Lo then
229 Issue_Msg (Bounds_Lo, Lo - 1);
232 for J in 2 .. Choice_Table'Last loop
233 Lo := Expr_Value (Choice_Table (J).Lo);
234 Hi := Expr_Value (Choice_Table (J).Hi);
236 if Lo <= Prev_Hi then
237 Prev_Choice := Choice_Table (J - 1).Node;
238 Choice := Choice_Table (J).Node;
240 if Sloc (Prev_Choice) <= Sloc (Choice) then
241 Error_Msg_Sloc := Sloc (Prev_Choice);
242 Error_Msg_N ("duplication of choice value#", Choice);
244 Error_Msg_Sloc := Sloc (Choice);
245 Error_Msg_N ("duplication of choice value#", Prev_Choice);
248 elsif not Others_Present and then Lo /= Prev_Hi + 1 then
249 Issue_Msg (Prev_Hi + 1, Lo - 1);
255 if not Others_Present and then Expr_Value (Bounds_Hi) > Hi then
256 Issue_Msg (Hi + 1, Bounds_Hi);
264 function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id is
265 Rtp : constant Entity_Id := Root_Type (Ctype);
270 -- For character, or wide [wide] character. If 7-bit ASCII graphic
271 -- range, then build and return appropriate character literal name
273 if Rtp = Standard_Character
274 or else Rtp = Standard_Wide_Character
275 or else Rtp = Standard_Wide_Wide_Character
277 C := UI_To_Int (Value);
279 if C in 16#20# .. 16#7E# then
280 Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
284 -- For user defined enumeration type, find enum/char literal
287 Lit := First_Literal (Rtp);
289 for J in 1 .. UI_To_Int (Value) loop
293 -- If enumeration literal, just return its value
295 if Nkind (Lit) = N_Defining_Identifier then
298 -- For character literal, get the name and use it if it is
299 -- for a 7-bit ASCII graphic character in 16#20#..16#7E#.
302 Get_Decoded_Name_String (Chars (Lit));
305 and then Name_Buffer (2) in
306 Character'Val (16#20#) .. Character'Val (16#7E#)
313 -- If we fall through, we have a character literal which is not in
314 -- the 7-bit ASCII graphic set. For such cases, we construct the
315 -- name "type'val(nnn)" where type is the choice type, and nnn is
316 -- the pos value passed as an argument to Choice_Image.
318 Get_Name_String (Chars (First_Subtype (Ctype)));
319 Name_Len := Name_Len + 1;
320 Name_Buffer (Name_Len) := ''';
321 Name_Len := Name_Len + 1;
322 Name_Buffer (Name_Len) := 'v';
323 Name_Len := Name_Len + 1;
324 Name_Buffer (Name_Len) := 'a';
325 Name_Len := Name_Len + 1;
326 Name_Buffer (Name_Len) := 'l';
327 Name_Len := Name_Len + 1;
328 Name_Buffer (Name_Len) := '(';
332 for J in 1 .. UI_Image_Length loop
333 Name_Len := Name_Len + 1;
334 Name_Buffer (Name_Len) := UI_Image_Buffer (J);
337 Name_Len := Name_Len + 1;
338 Name_Buffer (Name_Len) := ')';
342 --------------------------
343 -- Expand_Others_Choice --
344 --------------------------
346 procedure Expand_Others_Choice
347 (Case_Table : Choice_Table_Type;
348 Others_Choice : Node_Id;
349 Choice_Type : Entity_Id)
351 Loc : constant Source_Ptr := Sloc (Others_Choice);
352 Choice_List : constant List_Id := New_List;
360 function Build_Choice (Value1, Value2 : Uint) return Node_Id;
361 -- Builds a node representing the missing choices given by the
362 -- Value1 and Value2. A N_Range node is built if there is more than
363 -- one literal value missing. Otherwise a single N_Integer_Literal,
364 -- N_Identifier or N_Character_Literal is built depending on what
367 function Lit_Of (Value : Uint) return Node_Id;
368 -- Returns the Node_Id for the enumeration literal corresponding to the
369 -- position given by Value within the enumeration type Choice_Type.
375 function Build_Choice (Value1, Value2 : Uint) return Node_Id is
380 -- If there is only one choice value missing between Value1 and
381 -- Value2, build an integer or enumeration literal to represent it.
383 if (Value2 - Value1) = 0 then
384 if Is_Integer_Type (Choice_Type) then
385 Lit_Node := Make_Integer_Literal (Loc, Value1);
386 Set_Etype (Lit_Node, Choice_Type);
388 Lit_Node := Lit_Of (Value1);
391 -- Otherwise is more that one choice value that is missing between
392 -- Value1 and Value2, therefore build a N_Range node of either
393 -- integer or enumeration literals.
396 if Is_Integer_Type (Choice_Type) then
397 Lo := Make_Integer_Literal (Loc, Value1);
398 Set_Etype (Lo, Choice_Type);
399 Hi := Make_Integer_Literal (Loc, Value2);
400 Set_Etype (Hi, Choice_Type);
409 Low_Bound => Lit_Of (Value1),
410 High_Bound => Lit_Of (Value2));
421 function Lit_Of (Value : Uint) return Node_Id is
425 -- In the case where the literal is of type Character, there needs
426 -- to be some special handling since there is no explicit chain
427 -- of literals to search. Instead, a N_Character_Literal node
428 -- is created with the appropriate Char_Code and Chars fields.
430 if Root_Type (Choice_Type) = Standard_Character
432 Root_Type (Choice_Type) = Standard_Wide_Character
434 Root_Type (Choice_Type) = Standard_Wide_Wide_Character
436 Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
437 Lit := New_Node (N_Character_Literal, Loc);
438 Set_Chars (Lit, Name_Find);
439 Set_Char_Literal_Value (Lit, Value);
440 Set_Etype (Lit, Choice_Type);
441 Set_Is_Static_Expression (Lit, True);
444 -- Otherwise, iterate through the literals list of Choice_Type
445 -- "Value" number of times until the desired literal is reached
446 -- and then return an occurrence of it.
449 Lit := First_Literal (Choice_Type);
450 for J in 1 .. UI_To_Int (Value) loop
454 return New_Occurrence_Of (Lit, Loc);
458 -- Start of processing for Expand_Others_Choice
461 if Case_Table'Length = 0 then
463 -- Special case: only an others case is present.
464 -- The others case covers the full range of the type.
466 if Is_Static_Subtype (Choice_Type) then
467 Choice := New_Occurrence_Of (Choice_Type, Loc);
469 Choice := New_Occurrence_Of (Base_Type (Choice_Type), Loc);
472 Set_Others_Discrete_Choices (Others_Choice, New_List (Choice));
476 -- Establish the bound values for the choice depending upon whether
477 -- the type of the case statement is static or not.
479 if Is_OK_Static_Subtype (Choice_Type) then
480 Exp_Lo := Type_Low_Bound (Choice_Type);
481 Exp_Hi := Type_High_Bound (Choice_Type);
483 Exp_Lo := Type_Low_Bound (Base_Type (Choice_Type));
484 Exp_Hi := Type_High_Bound (Base_Type (Choice_Type));
487 Lo := Expr_Value (Case_Table (Case_Table'First).Lo);
488 Hi := Expr_Value (Case_Table (Case_Table'First).Hi);
489 Previous_Hi := Expr_Value (Case_Table (Case_Table'First).Hi);
491 -- Build the node for any missing choices that are smaller than any
492 -- explicit choices given in the case.
494 if Expr_Value (Exp_Lo) < Lo then
495 Append (Build_Choice (Expr_Value (Exp_Lo), Lo - 1), Choice_List);
498 -- Build the nodes representing any missing choices that lie between
499 -- the explicit ones given in the case.
501 for J in Case_Table'First + 1 .. Case_Table'Last loop
502 Lo := Expr_Value (Case_Table (J).Lo);
503 Hi := Expr_Value (Case_Table (J).Hi);
505 if Lo /= (Previous_Hi + 1) then
506 Append_To (Choice_List, Build_Choice (Previous_Hi + 1, Lo - 1));
512 -- Build the node for any missing choices that are greater than any
513 -- explicit choices given in the case.
515 if Expr_Value (Exp_Hi) > Hi then
516 Append (Build_Choice (Hi + 1, Expr_Value (Exp_Hi)), Choice_List);
519 Set_Others_Discrete_Choices (Others_Choice, Choice_List);
521 -- Warn on null others list if warning option set
523 if Warn_On_Redundant_Constructs
524 and then Comes_From_Source (Others_Choice)
525 and then Is_Empty_List (Choice_List)
527 Error_Msg_N ("?OTHERS choice is redundant", Others_Choice);
528 Error_Msg_N ("\previous choices cover all values", Others_Choice);
530 end Expand_Others_Choice;
536 procedure No_OP (C : Node_Id) is
537 pragma Warnings (Off, C);
543 --------------------------------
544 -- Generic_Choices_Processing --
545 --------------------------------
547 package body Generic_Choices_Processing is
549 ---------------------
550 -- Analyze_Choices --
551 ---------------------
553 procedure Analyze_Choices
556 Choice_Table : out Choice_Table_Type;
557 Last_Choice : out Nat;
558 Raises_CE : out Boolean;
559 Others_Present : out Boolean)
564 -- This is where we post error messages for bounds out of range
566 Nb_Choices : constant Nat := Choice_Table'Length;
567 Sort_Choice_Table : Sort_Choice_Table_Type (0 .. Nb_Choices);
569 Choice_Type : constant Entity_Id := Base_Type (Subtyp);
570 -- The actual type against which the discrete choices are
571 -- resolved. Note that this type is always the base type not the
572 -- subtype of the ruling expression, index or discriminant.
574 Bounds_Type : Entity_Id;
575 -- The type from which are derived the bounds of the values
576 -- covered by the discrete choices (see 3.8.1 (4)). If a discrete
577 -- choice specifies a value outside of these bounds we have an error.
581 -- The actual bounds of the above type.
583 Expected_Type : Entity_Id;
584 -- The expected type of each choice. Equal to Choice_Type, except
585 -- if the expression is universal, in which case the choices can
586 -- be of any integer type.
589 -- A case statement alternative or a variant in a record type
594 -- The node kind of the current Choice
596 Others_Choice : Node_Id := Empty;
597 -- Remember others choice if it is present (empty otherwise)
599 procedure Check (Choice : Node_Id; Lo, Hi : Node_Id);
600 -- Checks the validity of the bounds of a choice. When the bounds
601 -- are static and no error occurred the bounds are entered into
602 -- the choices table so that they can be sorted later on.
608 procedure Check (Choice : Node_Id; Lo, Hi : Node_Id) is
613 -- First check if an error was already detected on either bounds
615 if Etype (Lo) = Any_Type or else Etype (Hi) = Any_Type then
618 -- Do not insert non static choices in the table to be sorted
620 elsif not Is_Static_Expression (Lo)
621 or else not Is_Static_Expression (Hi)
623 Process_Non_Static_Choice (Choice);
626 -- Ignore range which raise constraint error
628 elsif Raises_Constraint_Error (Lo)
629 or else Raises_Constraint_Error (Hi)
634 -- Otherwise we have an OK static choice
637 Lo_Val := Expr_Value (Lo);
638 Hi_Val := Expr_Value (Hi);
640 -- Do not insert null ranges in the choices table
642 if Lo_Val > Hi_Val then
643 Process_Empty_Choice (Choice);
648 -- Check for low bound out of range
650 if Lo_Val < Bounds_Lo then
652 -- If the choice is an entity name, then it is a type, and
653 -- we want to post the message on the reference to this
654 -- entity. Otherwise we want to post it on the lower bound
657 if Is_Entity_Name (Choice) then
663 -- Specialize message for integer/enum type
665 if Is_Integer_Type (Bounds_Type) then
666 Error_Msg_Uint_1 := Bounds_Lo;
667 Error_Msg_N ("minimum allowed choice value is^", Enode);
669 Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
670 Error_Msg_N ("minimum allowed choice value is%", Enode);
674 -- Check for high bound out of range
676 if Hi_Val > Bounds_Hi then
678 -- If the choice is an entity name, then it is a type, and
679 -- we want to post the message on the reference to this
680 -- entity. Otherwise we want to post it on the upper bound
683 if Is_Entity_Name (Choice) then
689 -- Specialize message for integer/enum type
691 if Is_Integer_Type (Bounds_Type) then
692 Error_Msg_Uint_1 := Bounds_Hi;
693 Error_Msg_N ("maximum allowed choice value is^", Enode);
695 Error_Msg_Name_1 := Choice_Image (Bounds_Hi, Bounds_Type);
696 Error_Msg_N ("maximum allowed choice value is%", Enode);
700 -- Store bounds in the table
702 -- Note: we still store the bounds, even if they are out of
703 -- range, since this may prevent unnecessary cascaded errors
704 -- for values that are covered by such an excessive range.
706 Last_Choice := Last_Choice + 1;
707 Sort_Choice_Table (Last_Choice).Lo := Lo;
708 Sort_Choice_Table (Last_Choice).Hi := Hi;
709 Sort_Choice_Table (Last_Choice).Node := Choice;
712 -- Start of processing for Analyze_Choices
717 Others_Present := False;
719 -- If Subtyp is not a static subtype Ada 95 requires then we use
720 -- the bounds of its base type to determine the values covered by
721 -- the discrete choices.
723 if Is_OK_Static_Subtype (Subtyp) then
724 Bounds_Type := Subtyp;
726 Bounds_Type := Choice_Type;
729 -- Obtain static bounds of type, unless this is a generic formal
730 -- discrete type for which all choices will be non-static.
732 if not Is_Generic_Type (Root_Type (Bounds_Type))
733 or else Ekind (Bounds_Type) /= E_Enumeration_Type
735 Bounds_Lo := Expr_Value (Type_Low_Bound (Bounds_Type));
736 Bounds_Hi := Expr_Value (Type_High_Bound (Bounds_Type));
739 if Choice_Type = Universal_Integer then
740 Expected_Type := Any_Integer;
742 Expected_Type := Choice_Type;
745 -- Now loop through the case alternatives or record variants
747 Alt := First (Get_Alternatives (N));
748 while Present (Alt) loop
750 -- If pragma, just analyze it
752 if Nkind (Alt) = N_Pragma then
755 -- Otherwise check each choice against its base type
758 Choice := First (Get_Choices (Alt));
760 while Present (Choice) loop
762 Kind := Nkind (Choice);
767 or else (Kind = N_Attribute_Reference
768 and then Attribute_Name (Choice) = Name_Range)
770 Resolve (Choice, Expected_Type);
771 Check (Choice, Low_Bound (Choice), High_Bound (Choice));
773 -- Choice is a subtype name
775 elsif Is_Entity_Name (Choice)
776 and then Is_Type (Entity (Choice))
778 if not Covers (Expected_Type, Etype (Choice)) then
779 Wrong_Type (Choice, Choice_Type);
782 E := Entity (Choice);
784 if not Is_Static_Subtype (E) then
785 Process_Non_Static_Choice (Choice);
788 (Choice, Type_Low_Bound (E), Type_High_Bound (E));
792 -- Choice is a subtype indication
794 elsif Kind = N_Subtype_Indication then
795 Resolve_Discrete_Subtype_Indication
796 (Choice, Expected_Type);
798 if Etype (Choice) /= Any_Type then
800 C : constant Node_Id := Constraint (Choice);
801 R : constant Node_Id := Range_Expression (C);
802 L : constant Node_Id := Low_Bound (R);
803 H : constant Node_Id := High_Bound (R);
806 E := Entity (Subtype_Mark (Choice));
808 if not Is_Static_Subtype (E) then
809 Process_Non_Static_Choice (Choice);
812 if Is_OK_Static_Expression (L)
813 and then Is_OK_Static_Expression (H)
815 if Expr_Value (L) > Expr_Value (H) then
816 Process_Empty_Choice (Choice);
818 if Is_Out_Of_Range (L, E) then
819 Apply_Compile_Time_Constraint_Error
820 (L, "static value out of range",
821 CE_Range_Check_Failed);
824 if Is_Out_Of_Range (H, E) then
825 Apply_Compile_Time_Constraint_Error
826 (H, "static value out of range",
827 CE_Range_Check_Failed);
832 Check (Choice, L, H);
837 -- The others choice is only allowed for the last
838 -- alternative and as its only choice.
840 elsif Kind = N_Others_Choice then
841 if not (Choice = First (Get_Choices (Alt))
842 and then Choice = Last (Get_Choices (Alt))
843 and then Alt = Last (Get_Alternatives (N)))
846 ("the choice OTHERS must appear alone and last",
851 Others_Present := True;
852 Others_Choice := Choice;
854 -- Only other possibility is an expression
857 Resolve (Choice, Expected_Type);
858 Check (Choice, Choice, Choice);
864 Process_Associated_Node (Alt);
871 (Sort_Choice_Table (0 .. Last_Choice),
873 Others_Present or else (Choice_Type = Universal_Integer),
876 -- Now copy the sorted discrete choices
878 for J in 1 .. Last_Choice loop
879 Choice_Table (Choice_Table'First - 1 + J) := Sort_Choice_Table (J);
882 -- If no others choice we are all done, otherwise we have one more
883 -- step, which is to set the Others_Discrete_Choices field of the
884 -- others choice (to contain all otherwise unspecified choices).
885 -- Skip this if CE is known to be raised.
887 if Others_Present and not Raises_CE then
889 (Case_Table => Choice_Table (1 .. Last_Choice),
890 Others_Choice => Others_Choice,
891 Choice_Type => Bounds_Type);
895 -----------------------
896 -- Number_Of_Choices --
897 -----------------------
899 function Number_Of_Choices (N : Node_Id) return Nat is
901 -- A case statement alternative or a record variant
907 if not Present (Get_Alternatives (N)) then
911 Alt := First_Non_Pragma (Get_Alternatives (N));
912 while Present (Alt) loop
914 Choice := First (Get_Choices (Alt));
915 while Present (Choice) loop
916 if Nkind (Choice) /= N_Others_Choice then
923 Next_Non_Pragma (Alt);
927 end Number_Of_Choices;
929 end Generic_Choices_Processing;