Browse Source

* an incomplete case statement is not an error in ISO Pascal (mantis #35910)
* give a compile-time error in ISO/Extended Pascal if the compiler can prove
the case selector value is not handled, and a warning in other modes
(mantis #35915)
o trigger the case node simplification at the end of the case node typecheck
pass, like for other nodes

git-svn-id: trunk@42574 -

Jonas Maebe 6 years ago
parent
commit
46afcbb362

+ 5 - 0
.gitattributes

@@ -14111,6 +14111,11 @@ 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/tcasecov3a.pp svneol=native#text/plain
+tests/test/tcasecov3b.pp svneol=native#text/plain
+tests/test/tcasecov3c.pp svneol=native#text/plain
+tests/test/tcasecov3d.pp svneol=native#text/plain
+tests/test/tcasecov3e.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

+ 3 - 1
compiler/msg/errore.msg

@@ -2522,7 +2522,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_e_case_missing_value=06059_E_Case statement does not handle ordinal value "$1", and no else/otherwise statement is present.
+# The case statement does not handle the specified value and does not have an else/otherwise statement, and the compiler determined
+# that this value can be passed to the case statement. This is a compile-time error in ISO and Extended Pascal.
 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.
 %

+ 2 - 2
compiler/msgidx.inc

@@ -699,7 +699,7 @@ 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_e_case_missing_value=06059;
   cg_w_case_incomplete=06060;
   asmr_d_start_reading=07000;
   asmr_d_finish_reading=07001;
@@ -1112,7 +1112,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 83464;
+  MsgTxtSize = 83509;
 
   MsgIdxMax : array[1..20] of longint=(
     28,106,352,126,99,61,142,34,221,68,

File diff suppressed because it is too large
+ 318 - 320
compiler/msgtxt.inc


+ 31 - 21
compiler/nset.pas

@@ -688,11 +688,8 @@ implementation
         if assigned(elseblock) then
           typecheckpass(elseblock);
 
-        if not codegenerror and
-           is_ordinal(left.resultdef) then
-          checkordinalcoverage;
-
         resultdef:=voidtype;
+        result:=simplify(false);
       end;
 
 
@@ -786,6 +783,22 @@ implementation
          temp_cleanup:=nil;
          expectloc:=LOC_VOID;
 
+         { only do in pass_1, so that simplify can run first and
+             1) possibly simplify the case node without triggering a warning
+             2) possibly give a compile-time error if not all cases are handled
+                in ISO/Extended Pascal mode }
+         if is_ordinal(left.resultdef) then
+           checkordinalcoverage;
+
+         { ideally this would be in simplify, but then checkordinalcoverage can
+           false positives about case statements not handling all cases }
+         if assigned(elseblock) and
+            has_no_code(elseblock) then
+           begin
+             elseblock.free;
+             elseblock:=nil;
+           end;
+
          { evalutes the case expression }
          firstpass(left);
          set_varstate(left,vs_read,[vsf_must_be_valid]);
@@ -942,14 +955,14 @@ implementation
             if assigned(elseblock) then
               result:=elseblock.getcopy
             else
-              { 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;
+              begin
+                if ([m_iso,m_extpas]*current_settings.modeswitches)<>[] then
+                  cgmessage1(cg_e_case_missing_value,tostr(tordconstnode(left).value))
+                else
+                  cgmessage(cg_w_case_incomplete);
+                { no else block, so there is no code to execute at all }
+                result:=cnothingnode.create;
+              end;
           end;
       end;
 
@@ -1219,16 +1232,13 @@ implementation
                (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
+                cgmessage(cg_w_case_incomplete);
+                { in Standard/Extended Pascal, this is a dynamic violation error if it actually happens }
+                if ([m_extpas,m_iso]*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);
+                    elseblock:=ccallnode.createintern('fpc_rangeerror',nil);
+                    typecheckpass(elseblock);
+                  end;
               end
           end
         else if labelcoverage=typcount then

+ 1 - 0
tests/test/tcasecov1.pp

@@ -1,4 +1,5 @@
 { %fail }
+{ %opt=-Sew }
 {$mode iso}
 
 var

+ 11 - 0
tests/test/tcasecov3.pp

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

+ 11 - 0
tests/test/tcasecov3b.pp

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

+ 8 - 0
tests/test/tcasecov3c.pp

@@ -0,0 +1,8 @@
+{ %fail }
+{$mode iso}
+
+begin
+  case 1 of
+    2: writeln;
+  end;
+end.

+ 8 - 0
tests/test/tcasecov3d.pp

@@ -0,0 +1,8 @@
+{ %fail }
+{$mode extendedpascal}
+
+begin
+  case 1 of
+    2: writeln;
+  end;
+end.

+ 9 - 0
tests/test/tcasecov3e.pp

@@ -0,0 +1,9 @@
+{ %fail }
+{ %opt=-O- }
+{ %opt=-Sew }
+
+begin
+  case 1 of
+    2: writeln;
+  end;
+end.

+ 0 - 0
tests/test/tcasecov4.pp


Some files were not shown because too many files changed in this diff