From 406d3d3784ac822c6598956d2fbca541a8584dd6 Mon Sep 17 00:00:00 2001
From: "Paul \"LeoNerd\" Evans" <leonerd@leonerd.org.uk>
Date: Thu, 11 Jan 2024 17:39:27 +0000
Subject: [PATCH] Add experimental::qt warning

---
 MANIFEST          |  1 +
 lib/warnings.pm   | 27 +++++++++++++++++----------
 pod/perldiag.pod  |  6 ++++++
 regen/warnings.pl |  4 +++-
 t/lib/warnings/qt |  7 +++++++
 t/op/qt.t         |  1 +
 toke.c            |  3 +++
 warnings.h        |  7 ++++++-
 8 files changed, 44 insertions(+), 12 deletions(-)
 create mode 100644 t/lib/warnings/qt

diff --git a/MANIFEST b/MANIFEST
index ccb0d182ec3d5..00676fcc2189a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6135,6 +6135,7 @@ t/lib/warnings/pp_ctl			Tests for pp_ctl.c for warnings.t
 t/lib/warnings/pp_hot			Tests for pp_hot.c for warnings.t
 t/lib/warnings/pp_pack			Tests for pp_pack.c for warnings.t
 t/lib/warnings/pp_sys			Tests for pp_sys.c for warnings.t
+t/lib/warnings/qt			Tests for qt() syntax for warnings.t
 t/lib/warnings/regcomp			Tests for regcomp.c for warnings.t
 t/lib/warnings/regexec			Tests for regexec.c for warnings.t
 t/lib/warnings/run			Tests for run.c for warnings.t
diff --git a/lib/warnings.pm b/lib/warnings.pm
index c219f6befb080..1373b716726bd 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
 
 package warnings;
 
-our $VERSION = "1.67";
+our $VERSION = "1.68";
 
 # Verify that we're called correctly so that warnings will work.
 # Can't use Carp, since Carp uses us!
@@ -132,8 +132,11 @@ our %Offsets = (
     # Warnings Categories added in Perl 5.03701
     'deprecated::smartmatch'		=> 158,
 
+    # Warnings Categories added in Perl 5.039
+    'experimental::qt'			=> 160,
+
     # Warnings Categories added in Perl 5.03901
-    'deprecated::missing_import_called_with_args'=> 160,
+    'deprecated::missing_import_called_with_args'=> 162,
 );
 
 our %Bits = (
@@ -143,19 +146,19 @@ our %Bits = (
     'closed'				=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
     'closure'				=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
     'debugging'				=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'			=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x40\x00\x00\x40\x51\x01", # [2,48,49,63,75,76,78..80]
+    'deprecated'			=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x40\x00\x00\x40\x51\x04", # [2,48,49,63,75,76,78,79,81]
     'deprecated::apostrophe_as_package_separator'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [78]
     'deprecated::delimiter_will_be_paired'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [76]
     'deprecated::dot_in_inc'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [63]
     'deprecated::goto_construct'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [48]
-    'deprecated::missing_import_called_with_args'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [80]
+    'deprecated::missing_import_called_with_args'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [81]
     'deprecated::smartmatch'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [79]
     'deprecated::unicode_property_name'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [49]
     'deprecated::version_downgrade'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [75]
     'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
     'exec'				=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'				=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x15\x10\x54\x55\x05\x04\x00", # [53,54,56..58,62,65..73,77]
+    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x15\x10\x54\x55\x05\x04\x01", # [53,54,56..58,62,65..73,77,80]
     'experimental::args_array_with_signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [69]
     'experimental::builtin'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [70]
     'experimental::class'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [77]
@@ -165,6 +168,7 @@ our %Bits = (
     'experimental::extra_paired_delimiters'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [72]
     'experimental::for_list'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [73]
     'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [65]
+    'experimental::qt'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [80]
     'experimental::re_strict'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [57]
     'experimental::refaliasing'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [58]
     'experimental::regex_sets'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [54]
@@ -227,19 +231,19 @@ our %DeadBits = (
     'closed'				=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
     'closure'				=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
     'debugging'				=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
-    'deprecated'			=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x80\x00\x00\x80\xa2\x02", # [2,48,49,63,75,76,78..80]
+    'deprecated'			=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x80\x00\x00\x80\xa2\x08", # [2,48,49,63,75,76,78,79,81]
     'deprecated::apostrophe_as_package_separator'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [78]
     'deprecated::delimiter_will_be_paired'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [76]
     'deprecated::dot_in_inc'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [63]
     'deprecated::goto_construct'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [48]
-    'deprecated::missing_import_called_with_args'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [80]
+    'deprecated::missing_import_called_with_args'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [81]
     'deprecated::smartmatch'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [79]
     'deprecated::unicode_property_name'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [49]
     'deprecated::version_downgrade'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [75]
     'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
     'exec'				=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'				=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
-    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x2a\x20\xa8\xaa\x0a\x08\x00", # [53,54,56..58,62,65..73,77]
+    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x2a\x20\xa8\xaa\x0a\x08\x02", # [53,54,56..58,62,65..73,77,80]
     'experimental::args_array_with_signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [69]
     'experimental::builtin'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [70]
     'experimental::class'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [77]
@@ -249,6 +253,7 @@ our %DeadBits = (
     'experimental::extra_paired_delimiters'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [72]
     'experimental::for_list'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [73]
     'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [65]
+    'experimental::qt'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [80]
     'experimental::re_strict'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [57]
     'experimental::refaliasing'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [58]
     'experimental::regex_sets'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [54]
@@ -317,8 +322,8 @@ our %NoOp = (
 
 # These are used by various things, including our own tests
 our $NONE				=  "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-our $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x05\x00\x55\x50\x54\x55\x45\x55\x01"; # [2,4,22,23,25,48,49,56..59,62,63,65..73,75..80]
-our $LAST_BIT				=  162 ;
+our $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x05\x00\x55\x50\x54\x55\x45\x55\x05"; # [2,4,22,23,25,48,49,56..59,62,63,65..73,75..81]
+our $LAST_BIT				=  164 ;
 our $BYTES				=  21 ;
 
 sub Croaker
@@ -959,6 +964,8 @@ The current hierarchy is:
          |                 |
          |                 +- experimental::private_use
          |                 |
+         |                 +- experimental::qt
+         |                 |
          |                 +- experimental::re_strict
          |                 |
          |                 +- experimental::refaliasing
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 7d4f653c99b7b..a3887f87b8e40 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -5535,6 +5535,12 @@ and then thrown away. Any prototypes or attributes are therefore
 meaningless and are ignored. You should remove them from the C<BEGIN> block.
 Note this also means you cannot create a constant called C<BEGIN>.
 
+=item qt() is experimental
+
+(S experimental::qt) This warning is emitted if you use the C<qt()>
+templated quoting syntax.  This quoting form is currently experimental and
+its behaviour may change in future releases of Perl.
+
 =item Quantifier follows nothing in regex; marked by S<<-- HERE> in m/%s/
 
 (F) You started a regular expression with a quantifier.  Backslash it if
diff --git a/regen/warnings.pl b/regen/warnings.pl
index b46cfb599654d..f8bc9ca6d5416 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -16,7 +16,7 @@
 #
 # This script is normally invoked from regen.pl.
 
-$VERSION = '1.67';
+$VERSION = '1.68';
 
 BEGIN {
     require './regen/regen_lib.pl';
@@ -159,6 +159,8 @@ BEGIN
                                     [ 5.035, DEFAULT_ON],
                                 'experimental::class' =>
                                     [ 5.037, DEFAULT_ON ],
+                                'experimental::qt' =>
+                                    [ 5.039, DEFAULT_ON ],
                         }],
 
         'missing'       => [ 5.021, DEFAULT_OFF],
diff --git a/t/lib/warnings/qt b/t/lib/warnings/qt
new file mode 100644
index 0000000000000..ded5b18234899
--- /dev/null
+++ b/t/lib/warnings/qt
@@ -0,0 +1,7 @@
+toke.c		warnings from parsing qt() syntax
+__END__
+# experimental warnings
+use feature 'qt';
+my $str = qt{this is a quoted template string};
+EXPECT
+qt() is experimental at - line 3.
diff --git a/t/op/qt.t b/t/op/qt.t
index d318a8a9e73dd..e70939539d379 100644
--- a/t/op/qt.t
+++ b/t/op/qt.t
@@ -7,6 +7,7 @@ BEGIN {
 }
 
 use feature 'qt';
+no warnings 'experimental::qt';
 
 # Literal quoting
 is( qt{some literal text}, "some literal text", 'qt{} as literal' );
diff --git a/toke.c b/toke.c
index 690f5a5ab3313..c0aac7fc33f48 100644
--- a/toke.c
+++ b/toke.c
@@ -8554,6 +8554,9 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
         TERM(sublex_start());
 
     case KEY_qt:
+        Perl_ck_warner_d(aTHX_
+                         packWARN(WARN_EXPERIMENTAL__QT),
+                         "qt() is experimental");
         // For now parse purely as a single q(). Code entirely stolen from KEY_q
         s = scan_str(s,FALSE,FALSE,FALSE,NULL);
         if (!s)
diff --git a/warnings.h b/warnings.h
index eb82c272b7f50..2a1761e132c15 100644
--- a/warnings.h
+++ b/warnings.h
@@ -160,9 +160,13 @@
 
 #define WARN_DEPRECATED__SMARTMATCH	 79
 
+/* Warnings Categories added in Perl 5.039 */
+
+#define WARN_EXPERIMENTAL__QT		 80
+
 /* Warnings Categories added in Perl 5.03901 */
 
-#define WARN_DEPRECATED__MISSING_IMPORT_CALLED_WITH_ARGS 80
+#define WARN_DEPRECATED__MISSING_IMPORT_CALLED_WITH_ARGS 81
 #define WARNsize			 21
 #define WARN_ALLstring			 "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
 #define WARN_NONEstring			 "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
@@ -357,6 +361,7 @@ category parameters passed.
 =for apidoc Amnh||WARN_EXPERIMENTAL__CLASS
 =for apidoc Amnh||WARN_DEPRECATED__APOSTROPHE_AS_PACKAGE_SEPARATOR
 =for apidoc Amnh||WARN_DEPRECATED__SMARTMATCH
+=for apidoc Amnh||WARN_EXPERIMENTAL__QT
 =for apidoc Amnh||WARN_DEPRECATED__MISSING_IMPORT_CALLED_WITH_ARGS
 
 =cut