+ support for verifying whether a case statements handles all possibilities

(based on patch by Martok)
   o enabled by default in ISO and Extended Pascal: compile-time error if not
     the case in ISO mode, warning and run-time error in Extended Pascal mode
   o warning enabled by default in all other modes for boolean, enumeration and
     subrange integer types with ranges different from the default ones
     (i.e., different from 0..255, -128..127, 0..65536, etc)
   o warnings for all ordinal types can be enabled in all modes with
     -CC

git-svn-id: trunk@42047 -

.gitattributes

@@ -13005,6 +13005,15 @@ tests/test/tcase6.pp svneol=native#text/pascal
 tests/test/tcase7.pp svneol=native#text/pascal
 tests/test/tcase8.pp svneol=native#text/pascal
 tests/test/tcase9.pp svneol=native#text/pascal
+tests/test/tcasecov1.pp svneol=native#text/plain
+tests/test/tcasecov2.pp svneol=native#text/plain
+tests/test/tcasecov3.pp svneol=native#text/plain
+tests/test/tcasecov4.pp svneol=native#text/plain
+tests/test/tcasecov5.pp svneol=native#text/plain
+tests/test/tcasecov6.pp svneol=native#text/plain
+tests/test/tcasecov7.pp svneol=native#text/plain
+tests/test/tcasecov8.pp svneol=native#text/plain
+tests/test/tcasecov9.pp svneol=native#text/plain
 tests/test/tcg1.pp svneol=native#text/plain
 tests/test/tchlp1.pp svneol=native#text/pascal
 tests/test/tchlp10.pp svneol=native#text/pascal

compiler/globtype.pas

@@ -157,6 +157,7 @@ interface
          cs_do_inline,cs_fpu_fwait,cs_ieee_errors,
          cs_check_low_addr_load,cs_imported_data,
          cs_excessprecision,cs_check_fpu_exceptions,
+         cs_check_all_case_coverage,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }

compiler/msg/errore.msg

@@ -2365,7 +2365,7 @@ sym_e_type_must_be_rec_or_object=05098_E_Record or object type expected
 #
 # Codegenerator
 #
-# 06049 is the last used one
+# 06060 is the last used one
 #
 % \section{Code generator messages}
 % This section lists all messages that can be displayed if the code
@@ -2520,6 +2520,9 @@ cg_n_no_inline=06058_N_Call to subroutine "$1" marked as inline is not inlined
 % The directive inline is only a hint to the compiler. Sometimes the compiler ignores this hint, a subroutine
 % marked as inline is not inlined. In this case, this hint is given. Compiling with \var{-vd} might result in more information why
 % the directive inline is ignored.
+cg_e_case_incomplete=06059_E_Case statement does not handle all possible cases
+cg_w_case_incomplete=06060_W_Case statement does not handle all possible cases
+% The case statement does not contain labels for all possible values of the operand, and no else statement is present.
 %
 % \end{description}
 # EndOfTeX

compiler/msgidx.inc

@@ -698,6 +698,8 @@ const
   cg_e_function_not_support_by_selected_instruction_set=06056;
   cg_f_max_units_reached=06057;
   cg_n_no_inline=06058;
+  cg_e_case_incomplete=06059;
+  cg_w_case_incomplete=06060;
   asmr_d_start_reading=07000;
   asmr_d_finish_reading=07001;
   asmr_e_none_label_contain_at=07002;
@@ -1108,9 +1110,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82926;
+  MsgTxtSize = 83042;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,351,126,99,59,142,34,221,67,
+    28,106,351,126,99,61,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/ncgset.pas

@@ -73,11 +73,6 @@ interface
           jumptable_no_range : boolean;
           { has the implementation jumptable support }
           min_label : tconstexprint;
-          { Number of labels }
-          labelcnt: TCgInt;
-          { Number of individual values checked, counting each value in a range
-            individually (e.g. 0..2 counts as 3). }
-          TrueCount: TCgInt;
 
           function GetBranchLabel(Block: TNode; out _Label: TAsmLabel): Boolean;
 
@@ -1138,7 +1133,7 @@ implementation
 
       begin
         labelarray:=nil;
-        SetLength(labelarray,case_count_labels(root));
+        SetLength(labelarray,labelcnt);
         nextarrayentry:=0;
         addarrayentry(root);
         rebuild(0,high(labelarray),root);
@@ -1148,18 +1143,6 @@ implementation
       end;
 
     procedure tcgcasenode.pass_generate_code;
-
-      { Combines "case_count_labels" and "case_true_count" }
-      procedure CountBoth(p : pcaselabel);
-        begin
-          Inc(labelcnt);
-          Inc(TrueCount, (p^._high.svalue - p^._low.svalue) + 1);
-          if assigned(p^.less) then
-            CountBoth(p^.less);
-          if assigned(p^.greater) then
-            CountBoth(p^.greater);
-        end;
-
       var
          oldflowcontrol: tflowcontrol;
          i : longint;
@@ -1232,9 +1215,6 @@ implementation
          else
 {$endif not cpu64bitalu and not cpuhighleveltarget}
            begin
-              labelcnt := 0;
-              TrueCount := 0;
-
               if cs_opt_level1 in current_settings.optimizerswitches then
                 begin
                    { procedures are empirically passed on }
@@ -1245,8 +1225,6 @@ implementation
                    { ximated as it is not known if rel8,  }
                    { rel16 or rel32 jumps are used   }
 
-                   CountBoth(labels);
-
                    max_label := case_get_max(labels);
 
                    { can we omit the range check of the jump table ? }
@@ -1280,7 +1258,7 @@ implementation
                      end
                    else
                      begin
-                        max_dist:=4*TrueCount;
+                        max_dist:=4*labelcoverage;
 
                         { Don't allow jump tables to get too large }
                         if max_dist>4*labelcnt then

compiler/nset.pas

@@ -96,9 +96,22 @@ interface
        trangenodeclass = class of trangenode;
 
        tcasenode = class(tunarynode)
-          labels    : pcaselabel;
+        strict private
+          { Number of labels }
+          flabelcnt: cardinal;
+          { Number of individual values checked, counting each value in a range
+           individually (e.g. 0..2 counts as 3). }
+          flabelcoverage: qword;
+          fcountsuptodate: boolean;
+
+          function getlabelcnt: cardinal;
+          function getlabelcoverage: qword;
+          procedure updatecoverage;
+          procedure checkordinalcoverage;
+        public
           blocks    : TFPList;
           elseblock : tnode;
+
           constructor create(l:tnode);virtual;
           destructor destroy;override;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@@ -116,6 +129,13 @@ interface
           procedure addlabel(blockid:longint;l,h : tstringconstnode); overload;
           procedure addblock(blockid:longint;instr:tnode);
           procedure addelseblock(instr:tnode);
+
+          property labelcnt: cardinal read getlabelcnt;
+          property labelcoverage: qword read getlabelcoverage;
+         protected
+          flabels    : pcaselabel;
+         public
+          property labels: pcaselabel read flabels;
        end;
        tcasenodeclass = class of tcasenode;
 
@@ -125,11 +145,6 @@ interface
        crangenode : trangenodeclass = trangenode;
        ccasenode : tcasenodeclass = tcasenode;
 
-    { counts the labels }
-    function case_count_labels(root : pcaselabel) : longint;
-    { Returns the true count in a case block, which includes each individual
-      value in a range (e.g. "0..2" counts as 3) }
-    function case_true_count(root : pcaselabel) : longint;
     { searches the highest label }
     function case_get_max(root : pcaselabel) : tconstexprint;
     { searches the lowest label }
@@ -139,10 +154,11 @@ interface
 implementation
 
     uses
-      verbose,
+      verbose,cutils,
       symconst,symdef,symsym,symtable,defutil,defcmp,
       htypechk,pass_1,
-      nadd,nbas,ncnv,nld,cgbase;
+      nadd,nbas,ncal,ncnv,nld,nutils,
+      cgbase;
 
 
 {*****************************************************************************
@@ -430,35 +446,14 @@ implementation
                               Case Helpers
 *****************************************************************************}
 
-    function case_count_labels(root : pcaselabel) : longint;
-      var
-         _l : longint;
-
-      procedure count(p : pcaselabel);
-        begin
-           inc(_l);
-           if assigned(p^.less) then
-             count(p^.less);
-           if assigned(p^.greater) then
-             count(p^.greater);
-        end;
-
-      begin
-         _l:=0;
-         count(root);
-         case_count_labels:=_l;
-      end;
-
-
-    { Returns the true count in a case block, which includes each individual
+    { labels is the number of case-labels, while cases includes each individual
       value in a range (e.g. "0..2" counts as 3) }
-    function case_true_count(root : pcaselabel) : longint;
-      var
-         _l : longint;
+    procedure case_count_labels(root : pcaselabel; out labels, cases: longint);
 
       procedure count(p : pcaselabel);
         begin
-           inc(_l, (p^._high.svalue - p^._low.svalue) + 1);
+           inc(labels);
+           inc(cases, (p^._high.svalue - p^._low.svalue) + 1);
            if assigned(p^.less) then
              count(p^.less);
            if assigned(p^.greater) then
@@ -466,13 +461,12 @@ implementation
         end;
 
       begin
-        _l:=0;
+        labels:=0;
+        cases:=0;
         count(root);
-        case_true_count:=_l;
       end;
 
 
-
     function case_get_max(root : pcaselabel) : tconstexprint;
       var
          hp : pcaselabel;
@@ -597,7 +591,7 @@ implementation
     constructor tcasenode.create(l:tnode);
       begin
          inherited create(casen,l);
-         labels:=nil;
+         flabels:=nil;
          blocks:=TFPList.create;
          elseblock:=nil;
       end;
@@ -609,7 +603,7 @@ implementation
         hp : pcaseblock;
       begin
          elseblock.free;
-         deletecaselabels(labels);
+         deletecaselabels(flabels);
          for i:=0 to blocks.count-1 do
            begin
              pcaseblock(blocks[i])^.statement.free;
@@ -631,7 +625,9 @@ implementation
         blocks:=TFPList.create;
         for i:=0 to cnt-1 do
           addblock(i,ppuloadnode(ppufile));
-        labels:=ppuloadcaselabel(ppufile);
+        flabels:=ppuloadcaselabel(ppufile);
+        { we don't save/restore the label counts, but recalculate them if needed }
+        fcountsuptodate:=false;
       end;
 
 
@@ -644,7 +640,8 @@ implementation
         ppufile.putlongint(blocks.count);
         for i:=0 to blocks.count-1 do
           ppuwritenode(ppufile,pcaseblock(blocks[i])^.statement);
-        ppuwritecaselabel(ppufile,labels);
+        ppuwritecaselabel(ppufile,flabels);
+        { we don't save/restore the label counts, but recalculate them if needed }
       end;
 
 
@@ -686,6 +683,10 @@ implementation
         if assigned(elseblock) then
           typecheckpass(elseblock);
 
+        if not codegenerror and
+           is_ordinal(left.resultdef) then
+          checkordinalcoverage;
+
         resultdef:=voidtype;
       end;
 
@@ -726,7 +727,7 @@ implementation
         begin
           result:=tfpobjectlist.create(true);
           result.count:=blocks.count;
-          add_label_to_blockid_list(result,labels);
+          add_label_to_blockid_list(result,flabels);
         end;
 
       function makeifblock(elseblock : tnode): tnode;
@@ -789,7 +790,7 @@ implementation
          { Load caseexpr into temp var if complex. }
          { No need to do this for ordinal, because }
          { in that case caseexpr is generated once }
-         if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and
+         if (flabels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and
            (blocks.count > 0) then
            begin
              init_block := internalstatements(stmt);
@@ -832,7 +833,7 @@ implementation
                exit;
              end;
 
-         if (labels^.label_type = ltConstString) then
+         if (flabels^.label_type = ltConstString) then
            begin
              if_node:=makeifblock(elseblock);
 
@@ -856,41 +857,41 @@ implementation
              case blocks.count of
                2:
                  begin
-                   if boolean(qword(labels^._low))=false then
+                   if boolean(qword(flabels^._low))=false then
                      begin
-                       node_thenblock:=pcaseblock(blocks[labels^.greater^.blockid])^.statement;
-                       node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement;
-                       pcaseblock(blocks[labels^.greater^.blockid])^.statement:=nil;
+                       node_thenblock:=pcaseblock(blocks[flabels^.greater^.blockid])^.statement;
+                       node_elseblock:=pcaseblock(blocks[flabels^.blockid])^.statement;
+                       pcaseblock(blocks[flabels^.greater^.blockid])^.statement:=nil;
                      end
                    else
                      begin
-                       node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement;
-                       node_elseblock:=pcaseblock(blocks[labels^.less^.blockid])^.statement;
-                       pcaseblock(blocks[labels^.less^.blockid])^.statement:=nil;
+                       node_thenblock:=pcaseblock(blocks[flabels^.blockid])^.statement;
+                       node_elseblock:=pcaseblock(blocks[flabels^.less^.blockid])^.statement;
+                       pcaseblock(blocks[flabels^.less^.blockid])^.statement:=nil;
                      end;
-                   pcaseblock(blocks[labels^.blockid])^.statement:=nil;
+                   pcaseblock(blocks[flabels^.blockid])^.statement:=nil;
                  end;
                1:
                  begin
-                   if labels^._low=labels^._high then
+                   if flabels^._low=flabels^._high then
                      begin
-                       if boolean(qword(labels^._low))=false then
+                       if boolean(qword(flabels^._low))=false then
                          begin
                            node_thenblock:=elseblock;
-                           node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement;
+                           node_elseblock:=pcaseblock(blocks[flabels^.blockid])^.statement;
                          end
                        else
                          begin
-                           node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement;
+                           node_thenblock:=pcaseblock(blocks[flabels^.blockid])^.statement;
                            node_elseblock:=elseblock;
                          end;
-                       pcaseblock(blocks[labels^.blockid])^.statement:=nil;
+                       pcaseblock(blocks[flabels^.blockid])^.statement:=nil;
                        elseblock:=nil;
                      end
                    else
                      begin
-                       result:=pcaseblock(blocks[labels^.blockid])^.statement;
-                       pcaseblock(blocks[labels^.blockid])^.statement:=nil;
+                       result:=pcaseblock(blocks[flabels^.blockid])^.statement;
+                       pcaseblock(blocks[flabels^.blockid])^.statement:=nil;
                        elseblock:=nil;
                        exit;
                      end;
@@ -911,7 +912,7 @@ implementation
         result:=nil;
         if left.nodetype=ordconstn then
           begin
-            tmp:=labels;
+            tmp:=flabels;
             { check all case labels until we find one that fits }
             while assigned(tmp) do
               begin
@@ -939,6 +940,12 @@ implementation
               { no else block, so there is no code to execute at all }
               result:=cnothingnode.create;
           end;
+        if assigned(elseblock) and
+           has_no_code(elseblock) then
+          begin
+            elseblock.free;
+            elseblock:=nil;
+          end;
       end;
 
 
@@ -952,10 +959,10 @@ implementation
            n.elseblock:=elseblock.dogetcopy
          else
            n.elseblock:=nil;
-         if assigned(labels) then
-           n.labels:=copycaselabel(labels)
+         if assigned(flabels) then
+           n.flabels:=copycaselabel(flabels)
          else
-           n.labels:=nil;
+           n.flabels:=nil;
          if assigned(blocks) then
            begin
              n.blocks:=TFPList.create;
@@ -968,6 +975,9 @@ implementation
            end
          else
            n.blocks:=nil;
+         n.fcountsuptodate:=fcountsuptodate;
+         n.flabelcnt:=flabelcnt;
+         n.flabelcoverage:=flabelcoverage;
          dogetcopy:=n;
       end;
 
@@ -1041,7 +1051,7 @@ implementation
       begin
         result :=
           inherited docompare(p) and
-          caselabelsequal(labels,tcasenode(p).labels) and
+          caselabelsequal(flabels,tcasenode(p).flabels) and
           caseblocksequal(blocks,tcasenode(p).blocks) and
           elseblock.isequal(tcasenode(p).elseblock);
       end;
@@ -1066,6 +1076,117 @@ implementation
       end;
 
 
+    function tcasenode.getlabelcnt: cardinal;
+      begin
+        if not fcountsuptodate then
+          updatecoverage;
+        result:=flabelcnt;
+      end;
+
+
+    function tcasenode.getlabelcoverage: qword;
+      begin
+        if not fcountsuptodate then
+          updatecoverage;
+        result:=flabelcoverage;
+      end;
+
+
+    procedure tcasenode.updatecoverage;
+
+      var
+        isord: boolean;
+
+      procedure count(p : pcaselabel);
+        begin
+           inc(flabelcnt);
+           if isord then
+             inc(flabelcoverage, (p^._high.svalue - p^._low.svalue) + 1);
+           if assigned(p^.less) then
+             count(p^.less);
+           if assigned(p^.greater) then
+             count(p^.greater);
+        end;
+
+      begin
+        isord:=is_ordinal(left.resultdef);
+        flabelcnt:=0;
+        flabelcoverage:=0;
+        count(flabels);
+        fcountsuptodate:=true;
+      end;
+
+
+    procedure tcasenode.checkordinalcoverage;
+
+      function orddefspansfullrange(def: torddef): boolean;
+        var
+          packedbitsize: cardinal;
+          dummy: longint;
+          val: qword;
+        begin
+          result:=false;
+          packedbitsize:=def.packedbitsize;
+          if ((packedbitsize mod 8) <> 0) or
+             not ispowerof2(packedbitsize div 8,dummy) then
+            exit;
+          dec(packedbitsize);
+          if is_signed(def) then
+            begin
+              if def.low<>(-(int64(1) shl packedbitsize)) then
+                exit;
+              if def.high<>((int64(1) shl packedbitsize)-1) then
+                exit;
+            end
+          else
+            begin
+              if def.low<>0 then
+                exit;
+              val:=qword(1) shl packedbitsize;
+              val:=(val-1)+val;
+              if def.high<>val then
+                exit;
+            end;
+          result:=true;
+        end;
+
+      var
+        lv, hv, typcount: tconstexprint;
+      begin
+        { Check label type coverage for enumerations and small types }
+        getrange(left.resultdef,lv,hv);
+        typcount:=hv.svalue-lv.svalue+1;
+        if not assigned(elseblock) then
+          begin
+            { unless cs_check_all_case_coverage is set, only check for enums, booleans and
+              subrange types different from the default ones }
+            if (cs_check_all_case_coverage in current_settings.localswitches) or
+               (is_enum(left.resultdef) or
+                is_boolean(left.resultdef) or
+                not orddefspansfullrange(torddef(left.resultdef))) and
+               (labelcoverage<typcount) then
+              begin
+                { labels for some values of the operand are missing, and no else block is present }
+                if not(m_iso in current_settings.modeswitches) then
+                  begin
+                    cgmessage(cg_w_case_incomplete);
+                    { in Extended Pascal, this is a dynamic violation error if it actually happens }
+                    if (m_extpas in current_settings.modeswitches) then
+                      elseblock:=ccallnode.createintern('fpc_rangeerror',nil);
+                  end
+                else
+                  { this is an error in ISO Pascal }
+                  message(cg_e_case_incomplete);
+              end
+          end
+        else if labelcoverage=typcount then
+          begin
+            { labels for all values of the operand are present, but an extra else block is present }
+            MessagePos(elseblock.fileinfo, cg_w_unreachable_code);
+          end;
+      end;
+
+
     procedure tcasenode.addlabel(blockid:longint;const l,h : TConstExprInt);
       var
         hcaselabel : pcaselabel;
@@ -1120,7 +1241,8 @@ implementation
         hcaselabel^.label_type:=ltOrdinal;
         hcaselabel^._low:=l;
         hcaselabel^._high:=h;
-        insertlabel(labels);
+        insertlabel(flabels);
+        fcountsuptodate:=false;
       end;
 
     procedure tcasenode.addlabel(blockid: longint; l, h: tstringconstnode);
@@ -1160,7 +1282,7 @@ implementation
         hcaselabel^._low_str := tstringconstnode(l.getcopy);
         hcaselabel^._high_str := tstringconstnode(h.getcopy);
 
-        insertlabel(labels);
+        insertlabel(flabels);
       end;
 
 end.

compiler/options.pas

@@ -2036,6 +2036,11 @@ begin
                            exclude(init_settings.moduleswitches,cs_support_c_operators)
                          else
                            include(init_settings.moduleswitches,cs_support_c_operators);
+                       'C':
+                         If UnsetBool(More, j, opt, false) then
+                           exclude(init_settings.localswitches,cs_check_all_case_coverage)
+                         else
+                           include(init_settings.localswitches,cs_check_all_case_coverage);
                        'd' : //an alternative to -Mdelphi
                          SetCompileMode('DELPHI',true);
                        'e' :

compiler/optutils.pas

@@ -360,7 +360,7 @@ unit optutils;
 
     function SetExecutionWeight(var n: tnode; arg: pointer): foreachnoderesult;
       var
-        Weight : longint;
+        Weight, CaseWeight : longint;
         i : Integer;
       begin
         Result:=fen_false;
@@ -370,10 +370,11 @@ unit optutils;
           casen:
             begin
               CalcExecutionWeights(tcasenode(n).left,Weight);
+              CaseWeight:=max(Weight div tcasenode(n).labelcnt,1);
               for i:=0 to tcasenode(n).blocks.count-1 do
-                CalcExecutionWeights(pcaseblock(tcasenode(n).blocks[i])^.statement,Weight div case_count_labels(tcasenode(n).labels));
+                CalcExecutionWeights(pcaseblock(tcasenode(n).blocks[i])^.statement,CaseWeight);
 
-              CalcExecutionWeights(tcasenode(n).elseblock,Weight div case_count_labels(tcasenode(n).labels));
+              CalcExecutionWeights(tcasenode(n).elseblock,CaseWeight);
               Result:=fen_norecurse_false;
             end;
           whilerepeatn:

compiler/scandir.pas

@@ -436,6 +436,12 @@ unit scandir;
       end;
 
 
+    procedure dir_checkcasecoverage;
+      begin
+        do_localswitch(cs_check_all_case_coverage);
+      end;
+
+
     procedure dir_checkfpuexceptions;
       begin
         do_localswitch(cs_check_fpu_exceptions);
@@ -1908,6 +1914,7 @@ unit scandir;
         AddDirective('BOOLEVAL',directive_all, @dir_booleval);
         AddDirective('BITPACKING',directive_all, @dir_bitpacking);
         AddDirective('CALLING',directive_all, @dir_calling);
+        AddDirective('CHECKCASECOVERAGE',directive_all, @dir_checkcasecoverage);
         AddDirective('CHECKFPUEXCEPTIONS',directive_all, @dir_checkfpuexceptions);
         AddDirective('CHECKLOWADDRLOADS',directive_all, @dir_checklowaddrloads);
         AddDirective('CHECKPOINTER',directive_all, @dir_checkpointer);

compiler/scanner.pas

@@ -521,12 +521,17 @@ implementation
 
            HandleModeSwitches(m_none,changeinit);
 
-           { turn on bitpacking for mode macpas and iso pascal as well as extended pascal }
+           { turn on bitpacking and case checking for mode macpas and iso pascal,
+             as well as extended pascal }
            if ([m_mac,m_iso,m_extpas] * current_settings.modeswitches <> []) then
              begin
                include(current_settings.localswitches,cs_bitpacking);
+               include(current_settings.localswitches,cs_check_all_case_coverage);
                if changeinit then
-                 include(init_settings.localswitches,cs_bitpacking);
+                 begin
+                   include(init_settings.localswitches,cs_bitpacking);
+                   include(init_settings.localswitches,cs_check_all_case_coverage);
+                 end;
              end;
 
            { support goto/label by default in delphi/tp7/mac/iso/extpas modes }

compiler/x86/nx86set.pas

@@ -129,7 +129,7 @@ implementation
               { Limit size of jump tables for small enumerations so they have
                 to be at least two-thirds full before being considered for the
                 "almost exhaustive" treatment }
-              ExhaustiveLimit := min(ExhaustiveLimitBase, TrueCount shl 1)
+              ExhaustiveLimit := min(ExhaustiveLimitBase, labelcoverage shl 1)
             else
               ExhaustiveLimit := ExhaustiveLimitBase;
 

compiler/x86_64/nx64set.pas

@@ -128,7 +128,7 @@ implementation
               { Limit size of jump tables for small enumerations so they have
                 to be at least two-thirds full before being considered for the
                 "almost exhaustive" treatment }
-              ExhaustiveLimit := min(ExhaustiveLimitBase, TrueCount shl 1)
+              ExhaustiveLimit := min(ExhaustiveLimitBase, labelcoverage shl 1)
             else
               ExhaustiveLimit := ExhaustiveLimitBase;
 

tests/test/tcasecov1.pp

@@ -0,0 +1,11 @@
+{ %fail }
+{$mode iso}
+
+var
+  l: longint;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov2.pp

@@ -0,0 +1,12 @@
+{ %fail }
+{ %opt=-Sew }
+{$mode extendedpascal}
+
+var
+  l: longint;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov3.pp

@@ -0,0 +1,11 @@
+{ %result=201 }
+{$mode extendedpascal}
+
+var
+  l: longint;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov4.pp

@@ -0,0 +1,11 @@
+{ %opt=-Sew }
+{ %norun }
+
+var
+  l: longint;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov5.pp

@@ -0,0 +1,12 @@
+{ %opt=-Sew }
+{ %norun }
+
+{ should not print a warning }
+var
+  l: qword;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov6.pp

@@ -0,0 +1,12 @@
+{ %fail }
+{ %opt=-Sew }
+{ %norun }
+
+var
+  l: 0..3;
+begin
+  l:=1;
+  case l of
+    2: writeln;
+  end;
+end.

tests/test/tcasecov7.pp

@@ -0,0 +1,11 @@
+{ %opt=-Sew }
+{ %norun }
+
+var
+  s: shortstring;
+begin
+  s:='abc';
+  case s[1] of
+    'b': writeln;
+  end;
+end.

tests/test/tcasecov8.pp

@@ -0,0 +1,13 @@
+{ %opt=-Sew }
+{ %norun }
+
+const
+  OT_SIZE_MASK = $3000001F;
+var
+  l: longint;
+begin
+  l:=1;
+  case l and OT_SIZE_MASK of
+    1: writeln;
+  end;
+end.

tests/test/tcasecov9.pp

@@ -0,0 +1,15 @@
+{ %fail }
+{ %opt=-Sew }
+{ %norun }
+
+var
+  l: 0..1;
+begin
+  l:=1;
+  case l of
+    0: write('a');
+    1: writeln;
+    else
+      writeln('unreachable');
+  end;
+end.