From bc0d2293a1a89f2a352fafdb0924a30ede104322 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Fri, 9 Feb 2024 23:36:19 +0100
Subject: [PATCH]   * stricter type checking for set constants, resolves #40631

---
 compiler/ncnv.pas        | 58 +++++++++++++++++++++++-----------------
 tests/webtbf/tw40631a.pp |  9 +++++++
 tests/webtbf/tw40631b.pp |  9 +++++++
 tests/webtbf/tw40631c.pp | 10 +++++++
 4 files changed, 62 insertions(+), 24 deletions(-)
 create mode 100644 tests/webtbf/tw40631a.pp
 create mode 100644 tests/webtbf/tw40631b.pp
 create mode 100644 tests/webtbf/tw40631c.pp

diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 8bd0bc2c7d..f83593bf7d 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -503,6 +503,7 @@ implementation
         lr,hr : TConstExprInt;
         hp : tarrayconstructornode;
         oldfilepos: tfileposinfo;
+        first: Boolean;
       begin
         { keep in sync with arrayconstructor_can_be_set }
         if p.nodetype<>arrayconstructorn then
@@ -522,10 +523,11 @@ implementation
         hp:=tarrayconstructornode(p);
         if assigned(hp.left) then
          begin
+           first:=true;
            while assigned(hp) do
             begin
               p4:=nil; { will contain the tree to create the set }
-            {split a range into p2 and p3 }
+              { split a range into p2 and p3 }
               if hp.left.nodetype=arrayconstructorrangen then
                begin
                  p2:=tarrayconstructorrangenode(hp.left).left;
@@ -557,7 +559,6 @@ implementation
                       { widechars are not yet supported }
                       if is_widechar(p2.resultdef) then
                         begin
-
                           if block_type<>bt_const then
                             inserttypeconv(p2,cansichartype);
                           if (p2.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
@@ -596,7 +597,10 @@ implementation
                              if (p2.nodetype=ordconstn) and (p3.nodetype=ordconstn) then
                               begin
                                  if not(is_integer(p3.resultdef)) then
-                                   hdef:=p3.resultdef
+                                   begin
+                                     if not(assigned(hdef)) and first then
+                                       hdef:=p3.resultdef;
+                                   end
                                  else
                                    begin
                                      inserttypeconv(p3,u8inttype);
@@ -620,6 +624,8 @@ implementation
 
                                 if assigned(hdef) then
                                   inserttypeconv(p3,hdef)
+                                else if first then
+                                  hdef:=p3.resultdef
                                 else
                                   inserttypeconv(p3,u8inttype);
                                 p4:=csetelementnode.create(p2,p3);
@@ -631,14 +637,16 @@ implementation
                          { Single value }
                          if p2.nodetype=ordconstn then
                           begin
-                            if not(is_integer(p2.resultdef)) then
-                              update_constsethi(p2.resultdef,true);
-
                             if assigned(hdef) then
                               inserttypeconv(p2,hdef)
+                            else if not(is_integer(p2.resultdef)) and first then
+                              hdef:=p2.resultdef
                             else
                               inserttypeconv(p2,u8inttype);
 
+                            if not(is_integer(p2.resultdef)) then
+                              update_constsethi(p2.resultdef,true);
+
                             do_set(tordconstnode(p2).value.svalue);
                             p2.free;
                           end
@@ -648,6 +656,8 @@ implementation
 
                             if assigned(hdef) then
                               inserttypeconv(p2,hdef)
+                            else if not(is_integer(p2.resultdef)) and first then
+                              hdef:=p2.resultdef
                             else
                               inserttypeconv(p2,u8inttype);
 
@@ -658,23 +668,22 @@ implementation
 
                   stringdef :
                     begin
-                        if (p2.nodetype<>stringconstn) then
-                          Message(parser_e_illegal_expression)
-                        { if we've already set elements which are constants }
-                        { throw an error                                    }
-                        else if ((hdef=nil) and assigned(result)) or
-                          not(is_char(hdef)) then
-                          CGMessage(type_e_typeconflict_in_set)
-                        else
-                         for l:=1 to length(pshortstring(tstringconstnode(p2).value_str)^) do
-                          do_set(ord(pshortstring(tstringconstnode(p2).value_str)^[l]));
-                        if hdef=nil then
-                         hdef:=cansichartype;
-                        p2.free;
-                      end;
-
-                    else
-                      CGMessage(type_e_ordinal_expr_expected);
+                      if (p2.nodetype<>stringconstn) then
+                        Message(parser_e_illegal_expression)
+                      { if we've already set elements which are constants }
+                      { throw an error                                    }
+                      else if ((hdef=nil) and assigned(result)) or
+                        not(is_char(hdef)) then
+                        CGMessage(type_e_typeconflict_in_set)
+                      else
+                       for l:=1 to length(pshortstring(tstringconstnode(p2).value_str)^) do
+                        do_set(ord(pshortstring(tstringconstnode(p2).value_str)^[l]));
+                      if hdef=nil then
+                       hdef:=cansichartype;
+                      p2.free;
+                    end;
+                  else
+                    CGMessage(type_e_ordinal_expr_expected);
               end;
               { insert the set creation tree }
               if assigned(p4) then
@@ -686,8 +695,9 @@ implementation
               if freep then
                 p2.free;
               current_filepos:=oldfilepos;
+              first:=false;
             end;
-           if (hdef=nil) then
+          if (hdef=nil) then
             hdef:=u8inttype;
          end
         else
diff --git a/tests/webtbf/tw40631a.pp b/tests/webtbf/tw40631a.pp
new file mode 100644
index 0000000000..3450e3a8ec
--- /dev/null
+++ b/tests/webtbf/tw40631a.pp
@@ -0,0 +1,9 @@
+{ %fail }
+program test;
+{$mode objfpc} //$mode does not matter
+{$H+}
+
+const
+  Chars1: set of char = [255, 254, 253, #0, #1]; 
+begin
+end.
diff --git a/tests/webtbf/tw40631b.pp b/tests/webtbf/tw40631b.pp
new file mode 100644
index 0000000000..626b0b5b79
--- /dev/null
+++ b/tests/webtbf/tw40631b.pp
@@ -0,0 +1,9 @@
+{ %fail }
+program test;
+{$mode objfpc} //$mode does not matter
+{$H+}
+
+const
+  Chars2 = [98, '('];
+begin
+end.
diff --git a/tests/webtbf/tw40631c.pp b/tests/webtbf/tw40631c.pp
new file mode 100644
index 0000000000..7f4a0c9979
--- /dev/null
+++ b/tests/webtbf/tw40631c.pp
@@ -0,0 +1,10 @@
+{ %fail }
+program test;
+{$mode objfpc} //$mode does not matter
+{$H+}
+
+var
+  Ch: Char;
+begin
+  if Ch in [$FF, 'A'..'Z'] then;
+end.