[PATCH 08/12] libpoke: Fix printf %v for strings to give valid literals

[Mohammad-Reza Nabipoor]

2021-05-22  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/pkl-rt.pk (_pkl_escape_string): New function.
        * libpoke/pkl-gen.pks (string_printer): Use `_pkl_escape_string` to
        print valid string literals (replace non-printable characters with
        escape sequence).
        * testsuite/poke.pkl/printf-value-18.pk: New test.
        * testsuite/poke.pkl/printf-value-19.pk: Likewise.
        * testsuite/poke.pkl/printf-value-20.pk: Likewise.
        * testsuite/poke.pkl/printf-value-21.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
 ChangeLog                             | 12 ++++++++++
 libpoke/pkl-gen.pks                   |  1 +
 libpoke/pkl-rt.pk                     | 34 +++++++++++++++++++++++++++
 testsuite/Makefile.am                 |  4 ++++
 testsuite/poke.pkl/printf-value-18.pk |  6 +++++
 testsuite/poke.pkl/printf-value-19.pk |  6 +++++
 testsuite/poke.pkl/printf-value-20.pk |  6 +++++
 testsuite/poke.pkl/printf-value-21.pk |  6 +++++
 8 files changed, 75 insertions(+)
 create mode 100644 testsuite/poke.pkl/printf-value-18.pk
 create mode 100644 testsuite/poke.pkl/printf-value-19.pk
 create mode 100644 testsuite/poke.pkl/printf-value-20.pk
 create mode 100644 testsuite/poke.pkl/printf-value-21.pk

diff --git a/ChangeLog b/ChangeLog
index 5f628514..08cbe123 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2021-05-22  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/pkl-rt.pk (_pkl_escape_string): New function.
+       * libpoke/pkl-gen.pks (string_printer): Use `_pkl_escape_string` to
+       print valid string literals (replace non-printable characters with
+       escape sequence).
+       * testsuite/poke.pkl/printf-value-18.pk: New test.
+       * testsuite/poke.pkl/printf-value-19.pk: Likewise.
+       * testsuite/poke.pkl/printf-value-20.pk: Likewise.
+       * testsuite/poke.pkl/printf-value-21.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
 2021-05-22  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/pvm.jitter (strset): New instruction.
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index 431b0ef7..70f69485 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -1893,6 +1893,7 @@
         begsc
         push "\""
         prints
+        .call _pkl_escape_string; VAL
         prints
         push "\""
         prints
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index 033636e0..f8aa32b8 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -251,6 +251,40 @@ fun _pkl_base_prefix = (int<32> base) string:
    return "";
  }
 
+/* Return a new string in which all the non-printable characters are replaced
+   with a escape sequence (\xXX).  */
+
+fun _pkl_escape_string = (string str) string:
+  {
+    var chars = "0123456789abcdef",
+        len = str'length,
+        len_esc = 0;
+
+    /* Calculate the length of escaped string.  */
+    for (var i = 0UL; i < len; ++i)
+      len_esc += str[i] - 0x20UB < 0x5fUB /* is printable */ ? 1 : 4 /* \xXX 
*/;
+
+    var esc = "?" * len_esc;
+
+    for (var i = 0UL, j = 0UL; i < len; ++i)
+      {
+        if (str[i] - 0x20UB < 0x5fUB)
+          {
+            __pkl_unsafe_string_set (esc, j, str[i] as string);
+            ++j;
+          }
+        else
+          {
+            var nib_lo = chars[str[i] & 0xfUB] as string,
+                nib_hi = chars[(str[i] .>> 4) & 0xfUB] as string;
+
+            __pkl_unsafe_string_set (esc, j, "\\x" + nib_hi + nib_lo);
+            j += 4;
+          }
+      }
+    return esc;
+  }
+
 /* Return a string with the name corresponding to the given unit in
    bits.  This may be an empty string for an unknown unit.
 
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index afe35442..a8e8c7ed 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -1529,6 +1529,10 @@ EXTRA_DIST = \
   poke.pkl/printf-value-15.pk \
   poke.pkl/printf-value-16.pk \
   poke.pkl/printf-value-17.pk \
+  poke.pkl/printf-value-18.pk \
+  poke.pkl/printf-value-19.pk \
+  poke.pkl/printf-value-20.pk \
+  poke.pkl/printf-value-21.pk \
   poke.pkl/promo-array-arg-1.pk \
   poke.pkl/promo-array-arg-2.pk \
   poke.pkl/promo-array-arg-3.pk \
diff --git a/testsuite/poke.pkl/printf-value-18.pk 
b/testsuite/poke.pkl/printf-value-18.pk
new file mode 100644
index 00000000..5d62037e
--- /dev/null
+++ b/testsuite/poke.pkl/printf-value-18.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+var s = "A\x01\x02B";
+
+/* { dg-command { printf "%v\n", s } } */
+/* { dg-output {"A\\x01\\x02B"} } */
diff --git a/testsuite/poke.pkl/printf-value-19.pk 
b/testsuite/poke.pkl/printf-value-19.pk
new file mode 100644
index 00000000..3e1a37cd
--- /dev/null
+++ b/testsuite/poke.pkl/printf-value-19.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+var s = "A\x20B";
+
+/* { dg-command { printf "%v\n", s } } */
+/* { dg-output {"A B"} } */
diff --git a/testsuite/poke.pkl/printf-value-20.pk 
b/testsuite/poke.pkl/printf-value-20.pk
new file mode 100644
index 00000000..ed364d16
--- /dev/null
+++ b/testsuite/poke.pkl/printf-value-20.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+var s = "\x19";
+
+/* { dg-command { printf "%v\n", s } } */
+/* { dg-output {"\\x19"} } */
diff --git a/testsuite/poke.pkl/printf-value-21.pk 
b/testsuite/poke.pkl/printf-value-21.pk
new file mode 100644
index 00000000..78ec1215
--- /dev/null
+++ b/testsuite/poke.pkl/printf-value-21.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+var s = "\x18\x7f";
+
+/* { dg-command { printf "%v\n", s } } */
+/* { dg-output {"\\x18\\x7f"} } */
-- 
2.31.1