xgettext: Scheme: In language Scheme, handle backslash-newline as specified in R6RS.

Reported by Florent Angly <florent.angly@gmail.com>
at <https://savannah.gnu.org/bugs/?59262>.

* gettext-tools/src/x-scheme.c (read_object): Do R6RS-compliant interpretation
of backslash-newline if follow_guile is false.
* gettext-tools/tests/xgettext-scheme-7: New file.
* gettext-tools/tests/xgettext-scheme-8: New file.
* gettext-tools/tests/Makefile.am (TESTS): Add them.

diff --git a/gettext-tools/src/x-scheme.c b/gettext-tools/src/x-scheme.c
index 601fa760f4bd6be8ad9ed0e6220e4e5ddc0347f9..a13dc8f9dc7fdb233844a792519a0029116359a4 100644 (file)
--- a/gettext-tools/src/x-scheme.c
+++ b/gettext-tools/src/x-scheme.c
@@ -1512,10 +1512,50 @@ read_object (struct object *op, flag_region_ty *outer_region)
                     if (c == EOF)
                       /* Invalid input.  Be tolerant, no error message.  */
                       break;
-                    switch (c)
+                    if (c == ' ' || c == '\t')
+                      {
+                        if (follow_guile)
+                         /* Invalid input.  Be tolerant, no error message.  */
+                          ;
+                        else
+                          {
+                            /* In R6RS mode, a sequence of spaces and tabs is
+                               allowed between the backslash and the newline.
+                               Other than that, backslash-space and backslash-tab
+                               are not allowed.  See R6RS § 4.2.7, R7RS § 6.7.  */
+                            do
+                              c = phase1_getc ();
+                            while (c == ' ' || c == '\t');
+                            if (c == EOF)
+                              /* Invalid input.  Be tolerant, no error message.  */
+                              break;
+                            if (c != '\n')
+                              {
+                                /* Invalid input.  Be tolerant, no error message.  */
+                                phase1_ungetc (c);
+                                continue;
+                              }
+                          }
+                      }
+                    if (c == '\n')
                       {
-                      case '\n':
+                        if (!follow_guile)
+                          {
+                            /* In R6RS mode, a sequence of spaces and tabs is
+                               allowed after the newline and is discarded.
+                               See R6RS § 4.2.7, R7RS § 6.7.  */
+                            do
+                              c = phase1_getc ();
+                            while (c == ' ' || c == '\t');
+                            if (c == EOF)
+                              /* Invalid input.  Be tolerant, no error message.  */
+                              break;
+                            phase1_ungetc (c);
+                          }
                         continue;
+                      }
+                    switch (c)
+                      {
                       case '0':
                         c = '\0';
                         break;

diff --git a/gettext-tools/tests/Makefile.am b/gettext-tools/tests/Makefile.am
index f98e192cd55b52a645b1afd01397003431bf7b0b..c27d4b390f99dc8fc9db83d8c90b6165030c10f8 100644 (file)
--- a/gettext-tools/tests/Makefile.am
+++ b/gettext-tools/tests/Makefile.am
@@ -154,6 +154,7 @@ TESTS = gettext-1 gettext-2 \
        xgettext-ruby-1 \
        xgettext-scheme-1 xgettext-scheme-2 xgettext-scheme-3 \
        xgettext-scheme-4 xgettext-scheme-5 xgettext-scheme-6 \
+       xgettext-scheme-7 xgettext-scheme-8 \
        xgettext-scheme-format-1 xgettext-scheme-format-2 \
        xgettext-scheme-stackovfl-1 xgettext-scheme-stackovfl-2 \
        xgettext-sh-1 xgettext-sh-2 xgettext-sh-3 xgettext-sh-4 xgettext-sh-5 \

diff --git a/gettext-tools/tests/xgettext-scheme-7 b/gettext-tools/tests/xgettext-scheme-7
new file mode 100755 (executable)
index 0000000..bc0f263
--- /dev/null
+++ b/gettext-tools/tests/xgettext-scheme-7
@@ -0,0 +1,30 @@
+#!/bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test Scheme support: '-L Scheme' syntax.
+
+cat <<\EOF > xg-sc-7.scm
+(display (gettext "Llanfairpwllgwyngyllgogerychwyrn\
+                   drobwllllantysiliogogogoch"))
+(display (gettext "The hotel has a  \
+                   pretty garden."))
+EOF
+
+: ${XGETTEXT=xgettext}
+${XGETTEXT} -L Scheme --omit-header -d xg-sc-7 xg-sc-7.scm || Exit 1
+
+cat <<\EOF > xg-sc-7.ok
+#: xg-sc-7.scm:1
+msgid "Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch"
+msgstr ""
+
+#: xg-sc-7.scm:3
+msgid "The hotel has a  pretty garden."
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} xg-sc-7.ok xg-sc-7.po
+result=$?
+
+exit $result

diff --git a/gettext-tools/tests/xgettext-scheme-8 b/gettext-tools/tests/xgettext-scheme-8
new file mode 100755 (executable)
index 0000000..94dbbfd
--- /dev/null
+++ b/gettext-tools/tests/xgettext-scheme-8
@@ -0,0 +1,44 @@
+#!/bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test Scheme support: '-L Guile' syntax.
+
+cat <<\EOF > xg-sc-8.scm
+(display (gettext "Llanfairpwllgwyngyllgogerychwyrn\
+                   drobwllllantysiliogogogoch"))
+(display (gettext "The hotel has a  \
+                   pretty garden."))
+#!r6rs
+(display (gettext "Llanfairpwllgwyngyllgogerychwyrn\
+                   drobwllllantysiliogogogoch"))
+(display (gettext "The hotel has a  \
+                   pretty garden."))
+EOF
+
+: ${XGETTEXT=xgettext}
+${XGETTEXT} -L Guile --omit-header -d xg-sc-8 xg-sc-8.scm || Exit 1
+
+cat <<\EOF > xg-sc-8.ok
+#: xg-sc-8.scm:1
+msgid ""
+"Llanfairpwllgwyngyllgogerychwyrn                   drobwllllantysiliogogogoch"
+msgstr ""
+
+#: xg-sc-8.scm:3
+msgid "The hotel has a                     pretty garden."
+msgstr ""
+
+#: xg-sc-8.scm:6
+msgid "Llanfairpwllgwyngyllgogerychwyrndrobwllllantysiliogogogoch"
+msgstr ""
+
+#: xg-sc-8.scm:8
+msgid "The hotel has a  pretty garden."
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} xg-sc-8.ok xg-sc-8.po
+result=$?
+
+exit $result