gcc/ada/sem_case.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S E M _ C A S E                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Atree;    use Atree;
  30 with Einfo;    use Einfo;
  31 with Errout;   use Errout;
  32 with Namet;    use Namet;
  33 with Nlists;   use Nlists;
  34 with Sem;      use Sem;
  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 Uintp;    use Uintp;
  43
  44 with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;
  45
  46 package body Sem_Case is
  47
  48    -----------------------
  49    -- Local Subprograms --
  50    -----------------------
  51
  52    type Sort_Choice_Table_Type is array (Nat range <>) of Choice_Bounds;
  53    --  This new array type is used as the actual table type for sorting
  54    --  discrete choices. The reason for not using Choice_Table_Type, is that
  55    --  in Sort_Choice_Table_Type we reserve entry 0 for the sorting algortim
  56    --  (this is not absolutely necessary but it makes the code more
  57    --  efficient).
  58
  59    procedure Check_Choices
  60      (Choice_Table   : in out Sort_Choice_Table_Type;
  61       Bounds_Type    : Entity_Id;
  62       Others_Present : Boolean;
  63       Msg_Sloc       : Source_Ptr);
  64    --  This is the procedure which verifies that a set of case statement,
  65    --  array aggregate or record variant choices has no duplicates, and
  66    --  covers the range specified by Bounds_Type. Choice_Table contains the
  67    --  discrete choices to check. These must start at position 1.
  68    --  Furthermore Choice_Table (0) must exist. This element is used by
  69    --  the sorting algorithm as a temporary. Others_Present is a flag
  70    --  indicating whether or not an Others choice is present. Finally
  71    --  Msg_Sloc gives the source location of the construct containing the
  72    --  choices in the Choice_Table.
  73
  74    function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id;
  75    --  Given a Pos value of enumeration type Ctype, returns the name
  76    --  ID of an appropriate string to be used in error message output.
  77
  78    -------------------
  79    -- Check_Choices --
  80    -------------------
  81
  82    procedure Check_Choices
  83      (Choice_Table   : in out Sort_Choice_Table_Type;
  84       Bounds_Type    : Entity_Id;
  85       Others_Present : Boolean;
  86       Msg_Sloc       : Source_Ptr)
  87    is
  88
  89       function Lt_Choice (C1, C2 : Natural) return Boolean;
  90       --  Comparison routine for comparing Choice_Table entries.
  91       --  Use the lower bound of each Choice as the key.
  92
  93       procedure Move_Choice (From : Natural; To : Natural);
  94       --  Move routine for sorting the Choice_Table.
  95
  96       procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
  97       procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
  98       procedure Issue_Msg (Value1 : Uint;    Value2 : Node_Id);
  99       procedure Issue_Msg (Value1 : Uint;    Value2 : Uint);
 100       --  Issue an error message indicating that there are missing choices,
 101       --  followed by the image of the missing choices themselves which lie
 102       --  between Value1 and Value2 inclusive.
 103
 104       ---------------
 105       -- Issue_Msg --
 106       ---------------
 107
 108       procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id) is
 109       begin
 110          Issue_Msg (Expr_Value (Value1), Expr_Value (Value2));
 111       end Issue_Msg;
 112
 113       procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint) is
 114       begin
 115          Issue_Msg (Expr_Value (Value1), Value2);
 116       end Issue_Msg;
 117
 118       procedure Issue_Msg (Value1 : Uint; Value2 : Node_Id) is
 119       begin
 120          Issue_Msg (Value1, Expr_Value (Value2));
 121       end Issue_Msg;
 122
 123       procedure Issue_Msg (Value1 : Uint; Value2 : Uint) is
 124       begin
 125          --  In some situations, we call this with a null range, and
 126          --  obviously we don't want to complain in this case!
 127
 128          if Value1 > Value2 then
 129             return;
 130          end if;
 131
 132          --  Case of only one value that is missing
 133
 134          if Value1 = Value2 then
 135             if Is_Integer_Type (Bounds_Type) then
 136                Error_Msg_Uint_1 := Value1;
 137                Error_Msg ("missing case value: ^!", Msg_Sloc);
 138             else
 139                Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
 140                Error_Msg ("missing case value: %!", Msg_Sloc);
 141             end if;
 142
 143          --  More than one choice value, so print range of values
 144
 145          else
 146             if Is_Integer_Type (Bounds_Type) then
 147                Error_Msg_Uint_1 := Value1;
 148                Error_Msg_Uint_2 := Value2;
 149                Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
 150             else
 151                Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
 152                Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
 153                Error_Msg ("missing case values: % .. %!", Msg_Sloc);
 154             end if;
 155          end if;
 156       end Issue_Msg;
 157
 158       ---------------
 159       -- Lt_Choice --
 160       ---------------
 161
 162       function Lt_Choice (C1, C2 : Natural) return Boolean is
 163       begin
 164          return
 165            Expr_Value (Choice_Table (Nat (C1)).Lo)
 166            <= Expr_Value (Choice_Table (Nat (C2)).Lo);
 167       end Lt_Choice;
 168
 169       -----------------
 170       -- Move_Choice --
 171       -----------------
 172
 173       procedure Move_Choice (From : Natural; To : Natural) is
 174       begin
 175          Choice_Table (Nat (To)) := Choice_Table (Nat (From));
 176       end Move_Choice;
 177
 178       --  Variables local to Check_Choices
 179
 180       Choice      : Node_Id;
 181       Bounds_Lo   : constant Node_Id := Type_Low_Bound (Bounds_Type);
 182       Bounds_Hi   : constant Node_Id := Type_High_Bound (Bounds_Type);
 183
 184       Prev_Choice : Node_Id;
 185
 186       Hi       : Uint;
 187       Lo       : Uint;
 188       Prev_Hi  : Uint;
 189
 190    --  Start processing for Check_Choices
 191
 192    begin
 193
 194       --  Choice_Table must start at 0 which is an unused location used
 195       --  by the sorting algorithm. However the first valid position for
 196       --  a discrete choice is 1.
 197
 198       pragma Assert (Choice_Table'First = 0);
 199
 200       if Choice_Table'Last = 0 then
 201          if not Others_Present then
 202             Issue_Msg (Bounds_Lo, Bounds_Hi);
 203          end if;
 204          return;
 205       end if;
 206
 207       Sort
 208         (Positive (Choice_Table'Last),
 209          Move_Choice'Unrestricted_Access,
 210          Lt_Choice'Unrestricted_Access);
 211
 212       Lo      := Expr_Value (Choice_Table (1).Lo);
 213       Hi      := Expr_Value (Choice_Table (1).Hi);
 214       Prev_Hi := Hi;
 215
 216       if not Others_Present and then Expr_Value (Bounds_Lo) < Lo then
 217          Issue_Msg (Bounds_Lo, Lo - 1);
 218       end if;
 219
 220       for J in 2 .. Choice_Table'Last loop
 221          Lo := Expr_Value (Choice_Table (J).Lo);
 222          Hi := Expr_Value (Choice_Table (J).Hi);
 223
 224          if Lo <= Prev_Hi then
 225             Prev_Choice := Choice_Table (J - 1).Node;
 226             Choice      := Choice_Table (J).Node;
 227
 228             if Sloc (Prev_Choice) <= Sloc (Choice) then
 229                Error_Msg_Sloc := Sloc (Prev_Choice);
 230                Error_Msg_N ("duplication of choice value#", Choice);
 231             else
 232                Error_Msg_Sloc := Sloc (Choice);
 233                Error_Msg_N ("duplication of choice value#", Prev_Choice);
 234             end if;
 235
 236          elsif not Others_Present and then Lo /= Prev_Hi + 1 then
 237             Issue_Msg (Prev_Hi + 1, Lo - 1);
 238          end if;
 239
 240          Prev_Hi := Hi;
 241       end loop;
 242
 243       if not Others_Present and then Expr_Value (Bounds_Hi) > Hi then
 244          Issue_Msg (Hi + 1, Bounds_Hi);
 245       end if;
 246    end Check_Choices;
 247
 248    ------------------
 249    -- Choice_Image --
 250    ------------------
 251
 252    function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id is
 253       Rtp : constant Entity_Id := Root_Type (Ctype);
 254       Lit : Entity_Id;
 255       C   : Int;
 256
 257    begin
 258       --  For character, or wide character. If we are in 7-bit ASCII graphic
 259       --  range, then build and return appropriate character literal name
 260
 261       if Rtp = Standard_Character
 262         or else Rtp = Standard_Wide_Character
 263       then
 264          C := UI_To_Int (Value);
 265
 266          if C in 16#20# .. 16#7E# then
 267             Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
 268             return Name_Find;
 269          end if;
 270
 271       --  For user defined enumeration type, find enum/char literal
 272
 273       else
 274          Lit := First_Literal (Rtp);
 275
 276          for J in 1 .. UI_To_Int (Value) loop
 277             Next_Literal (Lit);
 278          end loop;
 279
 280          --  If enumeration literal, just return its value
 281
 282          if Nkind (Lit) = N_Defining_Identifier then
 283             return Chars (Lit);
 284
 285          --  For character literal, get the name and use it if it is
 286          --  for a 7-bit ASCII graphic character in 16#20#..16#7E#.
 287
 288          else
 289             Get_Decoded_Name_String (Chars (Lit));
 290
 291             if Name_Len = 3
 292               and then Name_Buffer (2) in
 293                 Character'Val (16#20#) .. Character'Val (16#7E#)
 294             then
 295                return Chars (Lit);
 296             end if;
 297          end if;
 298       end if;
 299
 300       --  If we fall through, we have a character literal which is not in
 301       --  the 7-bit ASCII graphic set. For such cases, we construct the
 302       --  name "type'val(nnn)" where type is the choice type, and nnn is
 303       --  the pos value passed as an argument to Choice_Image.
 304
 305       Get_Name_String (Chars (First_Subtype (Ctype)));
 306       Name_Len := Name_Len + 1;
 307       Name_Buffer (Name_Len) := ''';
 308       Name_Len := Name_Len + 1;
 309       Name_Buffer (Name_Len) := 'v';
 310       Name_Len := Name_Len + 1;
 311       Name_Buffer (Name_Len) := 'a';
 312       Name_Len := Name_Len + 1;
 313       Name_Buffer (Name_Len) := 'l';
 314       Name_Len := Name_Len + 1;
 315       Name_Buffer (Name_Len) := '(';
 316
 317       UI_Image (Value);
 318
 319       for J in 1 .. UI_Image_Length loop
 320          Name_Len := Name_Len + 1;
 321          Name_Buffer (Name_Len) := UI_Image_Buffer (J);
 322       end loop;
 323
 324       Name_Len := Name_Len + 1;
 325       Name_Buffer (Name_Len) := ')';
 326       return Name_Find;
 327    end Choice_Image;
 328
 329    -----------
 330    -- No_OP --
 331    -----------
 332
 333    procedure No_OP (C : Node_Id) is
 334    begin
 335       null;
 336    end No_OP;
 337
 338    --------------------------------
 339    -- Generic_Choices_Processing --
 340    --------------------------------
 341
 342    package body Generic_Choices_Processing is
 343
 344       ---------------------
 345       -- Analyze_Choices --
 346       ---------------------
 347
 348       procedure Analyze_Choices
 349         (N              : Node_Id;
 350          Subtyp         : Entity_Id;
 351          Choice_Table   : in out Choice_Table_Type;
 352          Last_Choice    : out Nat;
 353          Raises_CE      : out Boolean;
 354          Others_Present : out Boolean)
 355       is
 356
 357          Nb_Choices        : constant Nat := Choice_Table'Length;
 358          Sort_Choice_Table : Sort_Choice_Table_Type (0 .. Nb_Choices);
 359
 360          Choice_Type : constant Entity_Id := Base_Type (Subtyp);
 361          --  The actual type against which the discrete choices are
 362          --  resolved.  Note that this type is always the base type not the
 363          --  subtype of the ruling expression, index or discriminant.
 364
 365          Bounds_Type : Entity_Id;
 366          --  The type from which are derived the bounds of the values
 367          --  covered by th discrete choices (see 3.8.1 (4)). If a discrete
 368          --  choice specifies a value outside of these bounds we have an error.
 369
 370          Bounds_Lo   : Uint;
 371          Bounds_Hi   : Uint;
 372          --  The actual bounds of the above type.
 373
 374          Expected_Type : Entity_Id;
 375          --  The expected type of each choice. Equal to Choice_Type, except
 376          --  if the expression is universal,  in which case the choices can
 377          --  be of any integer type.
 378
 379          procedure Check (Choice : Node_Id; Lo, Hi : Node_Id);
 380          --  Checks the validity of the bounds of a choice.  When the bounds
 381          --  are static and no error occurred the bounds are entered into
 382          --  the choices table so that they can be sorted later on.
 383
 384          -----------
 385          -- Check --
 386          -----------
 387
 388          procedure Check (Choice : Node_Id; Lo, Hi : Node_Id) is
 389             Lo_Val : Uint;
 390             Hi_Val : Uint;
 391
 392          begin
 393             --  First check if an error was already detected on either bounds
 394
 395             if Etype (Lo) = Any_Type or else Etype (Hi) = Any_Type then
 396                return;
 397
 398             --  Do not insert non static choices in the table to be sorted
 399
 400             elsif not Is_Static_Expression (Lo)
 401               or else not Is_Static_Expression (Hi)
 402             then
 403                Process_Non_Static_Choice (Choice);
 404                return;
 405
 406             --  Ignore range which raise constraint error
 407
 408             elsif Raises_Constraint_Error (Lo)
 409               or else Raises_Constraint_Error (Hi)
 410             then
 411                Raises_CE := True;
 412                return;
 413
 414             --  Otherwise we have an OK static choice
 415
 416             else
 417                Lo_Val := Expr_Value (Lo);
 418                Hi_Val := Expr_Value (Hi);
 419
 420                --  Do not insert null ranges in the choices table
 421
 422                if Lo_Val > Hi_Val then
 423                   Process_Empty_Choice (Choice);
 424                   return;
 425                end if;
 426             end if;
 427
 428             --  Check for bound out of range.
 429
 430             if Lo_Val < Bounds_Lo then
 431                if Is_Integer_Type (Bounds_Type) then
 432                   Error_Msg_Uint_1 := Bounds_Lo;
 433                   Error_Msg_N ("minimum allowed choice value is^", Lo);
 434                else
 435                   Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
 436                   Error_Msg_N ("minimum allowed choice value is%", Lo);
 437                end if;
 438
 439             elsif Hi_Val > Bounds_Hi then
 440                if Is_Integer_Type (Bounds_Type) then
 441                   Error_Msg_Uint_1 := Bounds_Hi;
 442                   Error_Msg_N ("maximum allowed choice value is^", Hi);
 443                else
 444                   Error_Msg_Name_1 := Choice_Image (Bounds_Hi, Bounds_Type);
 445                   Error_Msg_N ("maximum allowed choice value is%", Hi);
 446                end if;
 447             end if;
 448
 449             --  We still store the bounds in the table, even if they are out
 450             --  of range, since this may prevent unnecessary cascaded errors
 451             --  for values that are covered by such an excessive range.
 452
 453             Last_Choice := Last_Choice + 1;
 454             Sort_Choice_Table (Last_Choice).Lo   := Lo;
 455             Sort_Choice_Table (Last_Choice).Hi   := Hi;
 456             Sort_Choice_Table (Last_Choice).Node := Choice;
 457          end Check;
 458
 459          --  Variables local to Analyze_Choices
 460
 461          Alt : Node_Id;
 462          --  A case statement alternative, an array aggregate component
 463          --  association or a variant in a record type declaration
 464
 465          Choice : Node_Id;
 466          Kind   : Node_Kind;
 467          --  The node kind of the current Choice.
 468
 469          E : Entity_Id;
 470
 471       --  Start of processing for Analyze_Choices
 472
 473       begin
 474          Last_Choice    := 0;
 475          Raises_CE      := False;
 476          Others_Present := False;
 477
 478          --  If Subtyp is not a static subtype Ada 95 requires then we use
 479          --  the bounds of its base type to determine the values covered by
 480          --  the discrete choices.
 481
 482          if Is_OK_Static_Subtype (Subtyp) then
 483             Bounds_Type := Subtyp;
 484          else
 485             Bounds_Type := Choice_Type;
 486          end if;
 487
 488          --  Obtain static bounds of type, unless this is a generic formal
 489          --  discrete type for which all choices will be non-static.
 490
 491          if not Is_Generic_Type (Root_Type (Bounds_Type))
 492            or else Ekind (Bounds_Type) /= E_Enumeration_Type
 493          then
 494             Bounds_Lo := Expr_Value (Type_Low_Bound (Bounds_Type));
 495             Bounds_Hi := Expr_Value (Type_High_Bound (Bounds_Type));
 496          end if;
 497
 498          if Choice_Type = Universal_Integer then
 499             Expected_Type := Any_Integer;
 500          else
 501             Expected_Type := Choice_Type;
 502          end if;
 503
 504          --  Now loop through the case statement alternatives or array
 505          --  aggregate component associations or record variants.
 506
 507          Alt := First (Get_Alternatives (N));
 508          while Present (Alt) loop
 509
 510             --  If pragma, just analyze it
 511
 512             if Nkind (Alt) = N_Pragma then
 513                Analyze (Alt);
 514
 515             --  Otherwise check each choice against its base type
 516
 517             else
 518                Choice := First (Get_Choices (Alt));
 519
 520                while Present (Choice) loop
 521                   Analyze (Choice);
 522                   Kind := Nkind (Choice);
 523
 524                   --  Choice is a Range
 525
 526                   if Kind = N_Range
 527                     or else (Kind = N_Attribute_Reference
 528                              and then Attribute_Name (Choice) = Name_Range)
 529                   then
 530                      Resolve (Choice, Expected_Type);
 531                      Check (Choice, Low_Bound (Choice), High_Bound (Choice));
 532
 533                   --  Choice is a subtype name
 534
 535                   elsif Is_Entity_Name (Choice)
 536                     and then Is_Type (Entity (Choice))
 537                   then
 538                      if not Covers (Expected_Type, Etype (Choice)) then
 539                         Wrong_Type (Choice, Choice_Type);
 540
 541                      else
 542                         E := Entity (Choice);
 543
 544                         if not Is_Static_Subtype (E) then
 545                            Process_Non_Static_Choice (Choice);
 546                         else
 547                            Check
 548                              (Choice, Type_Low_Bound (E), Type_High_Bound (E));
 549                         end if;
 550                      end if;
 551
 552                   --  Choice is a subtype indication
 553
 554                   elsif Kind = N_Subtype_Indication then
 555                      Resolve_Discrete_Subtype_Indication
 556                        (Choice, Expected_Type);
 557
 558                      if Etype (Choice) /= Any_Type then
 559                         declare
 560                            C : constant Node_Id := Constraint (Choice);
 561                            R : constant Node_Id := Range_Expression (C);
 562                            L : constant Node_Id := Low_Bound (R);
 563                            H : constant Node_Id := High_Bound (R);
 564
 565                         begin
 566                            E := Entity (Subtype_Mark (Choice));
 567
 568                            if not Is_Static_Subtype (E) then
 569                               Process_Non_Static_Choice (Choice);
 570
 571                            else
 572                               if Is_OK_Static_Expression (L)
 573                                 and then Is_OK_Static_Expression (H)
 574                               then
 575                                  if Expr_Value (L) > Expr_Value (H) then
 576                                     Process_Empty_Choice (Choice);
 577                                  else
 578                                     if Is_Out_Of_Range (L, E) then
 579                                        Apply_Compile_Time_Constraint_Error
 580                                          (L, "static value out of range");
 581                                     end if;
 582
 583                                     if Is_Out_Of_Range (H, E) then
 584                                        Apply_Compile_Time_Constraint_Error
 585                                          (H, "static value out of range");
 586                                     end if;
 587                                  end if;
 588                               end if;
 589
 590                               Check (Choice, L, H);
 591                            end if;
 592                         end;
 593                      end if;
 594
 595                   --  The others choice is only allowed for the last
 596                   --  alternative and as its only choice.
 597
 598                   elsif Kind = N_Others_Choice then
 599                      if not (Choice = First (Get_Choices (Alt))
 600                              and then Choice = Last (Get_Choices (Alt))
 601                              and then Alt = Last (Get_Alternatives (N)))
 602                      then
 603                         Error_Msg_N
 604                           ("the choice OTHERS must appear alone and last",
 605                            Choice);
 606                         return;
 607                      end if;
 608
 609                      Others_Present := True;
 610
 611                   --  Only other possibility is an expression
 612
 613                   else
 614                      Resolve (Choice, Expected_Type);
 615                      Check (Choice, Choice, Choice);
 616                   end if;
 617
 618                   Next (Choice);
 619                end loop;
 620
 621                Process_Associated_Node (Alt);
 622             end if;
 623
 624             Next (Alt);
 625          end loop;
 626
 627          Check_Choices
 628            (Sort_Choice_Table (0 .. Last_Choice),
 629             Bounds_Type,
 630             Others_Present or else (Choice_Type = Universal_Integer),
 631             Sloc (N));
 632
 633          --  Now copy the sorted discrete choices
 634
 635          for J in 1 .. Last_Choice loop
 636             Choice_Table (Choice_Table'First - 1 + J) := Sort_Choice_Table (J);
 637          end loop;
 638
 639       end Analyze_Choices;
 640
 641       -----------------------
 642       -- Number_Of_Choices --
 643       -----------------------
 644
 645       function Number_Of_Choices (N : Node_Id) return Nat is
 646          Alt : Node_Id;
 647          --  A case statement alternative, an array aggregate component
 648          --  association or a record variant.
 649
 650          Choice : Node_Id;
 651          Count  : Nat := 0;
 652
 653       begin
 654          if not Present (Get_Alternatives (N)) then
 655             return 0;
 656          end if;
 657
 658          Alt := First_Non_Pragma (Get_Alternatives (N));
 659          while Present (Alt) loop
 660
 661             Choice := First (Get_Choices (Alt));
 662             while Present (Choice) loop
 663                if Nkind (Choice) /= N_Others_Choice then
 664                   Count := Count + 1;
 665                end if;
 666
 667                Next (Choice);
 668             end loop;
 669
 670             Next_Non_Pragma (Alt);
 671          end loop;
 672
 673          return Count;
 674       end Number_Of_Choices;
 675
 676    end Generic_Choices_Processing;
 677
 678 end Sem_Case;