From: Bruno Haible <bruno@clisp.org>
Date: Mon, 14 May 2018 18:57:34 +0000 (+0200)
Subject: xgettext: Improve support for specialized vector syntax in Scheme.
X-Git-Tag: v0.20~407
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1e07b4420093afa122a3c42e4c531d2633e5fae1;p=thirdparty%2Fgettext.git

xgettext: Improve support for specialized vector syntax in Scheme.

Reported by Florent Angly <Florent.Angly@cslbehring.com>.

* gettext-tools/src/x-scheme.c (read_object): Don't call free_token on an
uninitialized token. Support recent syntax for homogeneous vector types (SRFI-4)
and byte vectors as well.
* NEWS: Mention the change.
---

diff --git a/NEWS b/NEWS
index 46edd51c3..0117130b8 100644
--- a/NEWS
+++ b/NEWS
@@ -24,6 +24,9 @@
       npgettext, dnpgettext, dcnpgettext).
     o better detection of question mark and slash as operators (as opposed 
       to regular expression delimiters).
+  - Scheme:
+    xgettext now parses the syntax for specialized byte vectors (#u8(...),
+    #vu8(...), etc.) correctly.
   - Pascal:
     xgettext can now extract strings from .rsj files, produced by the
     Free Pascal compiler version 3.0.0 or newer.
diff --git a/gettext-tools/src/x-scheme.c b/gettext-tools/src/x-scheme.c
index 194f3588c..d04e65568 100644
--- a/gettext-tools/src/x-scheme.c
+++ b/gettext-tools/src/x-scheme.c
@@ -868,11 +868,93 @@ read_object (struct object *op, flag_context_ty outer_context)
                 }
 
               case 'T': case 't': /* Boolean true */
-              case 'F': case 'f': /* Boolean false */
+              case 'F': /* Boolean false */
                 op->type = t_other;
                 last_non_comment_line = line_number;
                 return;
 
+              case 'a':
+              case 'c':
+              case 'f':
+              case 'h':
+              case 'l':
+              case 's':
+              case 'u':
+              case 'v':
+              case 'y':
+                {
+                  struct token token;
+                  do_ungetc (c);
+                  read_token (&token, '#');
+                  if ((token.charcount == 2
+                       && (token.chars[1] == 'a' || token.chars[1] == 'c'
+                           || token.chars[1] == 'h' || token.chars[1] == 'l'
+                           || token.chars[1] == 's' || token.chars[1] == 'u'
+                           || token.chars[1] == 'y'))
+                      || (token.charcount == 3
+                          && (token.chars[1] == 's' || token.chars[1] == 'u')
+                          && token.chars[2] == '8')
+                      || (token.charcount == 4
+                          && (((token.chars[1] == 's' || token.chars[1] == 'u')
+                               && token.chars[2] == '1'
+                               && token.chars[3] == '6')
+                              || ((token.chars[1] == 'c'
+                                   || token.chars[1] == 'f'
+                                   || token.chars[1] == 's'
+                                   || token.chars[1] == 'u')
+                                  && ((token.chars[2] == '3'
+                                       && token.chars[3] == '2')
+                                      || (token.chars[2] == '6'
+                                          && token.chars[3] == '4')))
+                              || (token.chars[1] == 'v'
+                                  && token.chars[2] == 'u'
+                                  && token.chars[3] == '8'))))
+                    {
+                      c = do_getc ();
+                      if (c != EOF)
+                        do_ungetc (c);
+                      if (c == '(')
+                        {
+                          /* Homogenous vector syntax:
+                               #a(...) - vector of char
+                               #c(...) - vector of complex (old)
+                               #c32(...) - vector of complex of single-float
+                               #c64(...) - vector of complex of double-float
+                               #f32(...) - vector of single-float
+                               #f64(...) - vector of double-float
+                               #h(...) - vector of short (old)
+                               #l(...) - vector of long long (old)
+                               #s(...) - vector of single-float (old)
+                               #s8(...) - vector of signed 8-bit integers
+                               #s16(...) - vector of signed 16-bit integers
+                               #s32(...) - vector of signed 32-bit integers
+                               #s64(...) - vector of signed 64-bit integers
+                               #u(...) - vector of unsigned long (old)
+                               #u8(...) - vector of unsigned 8-bit integers
+                               #u16(...) - vector of unsigned 16-bit integers
+                               #u32(...) - vector of unsigned 32-bit integers
+                               #u64(...) - vector of unsigned 64-bit integers
+                               #vu8(...) - vector of byte
+                               #y(...) - vector of byte (old)
+                           */
+                          struct object inner;
+                          read_object (&inner, null_context);
+                          /* Dots and EOF are not allowed here.
+                             But be tolerant.  */
+                          free_token (&token);
+                          free_object (&inner);
+                          op->type = t_other;
+                          last_non_comment_line = line_number;
+                          return;
+                        }
+                    }
+                  /* Boolean false, or unknown # object.  But be tolerant.  */
+                  free_token (&token);
+                  op->type = t_other;
+                  last_non_comment_line = line_number;
+                  return;
+                }
+
               case 'B': case 'b':
               case 'O': case 'o':
               case 'D': case 'd':
@@ -900,27 +982,21 @@ read_object (struct object *op, flag_context_ty outer_context)
                           if (c != EOF)
                             do_ungetc (c);
                           if (c == '(')
-                            /* Homogenous vector syntax, see arrays.scm.  */
-                            case 'a':   /* Vectors of char */
-                            case 'c':   /* Vectors of complex */
-                          /*case 'e':*/ /* Vectors of long */
-                            case 'h':   /* Vectors of short */
-                          /*case 'i':*/ /* Vectors of double-float */
-                            case 'l':   /* Vectors of long long */
-                            case 's':   /* Vectors of single-float */
-                            case 'u':   /* Vectors of unsigned long */
-                            case 'y':   /* Vectors of byte */
-                              {
-                                struct object inner;
-                                read_object (&inner, null_context);
-                                /* Dots and EOF are not allowed here.
-                                   But be tolerant.  */
-                                free_token (&token);
-                                free_object (&inner);
-                                op->type = t_other;
-                                last_non_comment_line = line_number;
-                                return;
-                              }
+                            {
+                              /* Homogenous vector syntax:
+                                   #e(...) - vector of long (old)
+                                   #i(...) - vector of double-float (old)
+                               */
+                              struct object inner;
+                              read_object (&inner, null_context);
+                              /* Dots and EOF are not allowed here.
+                                 But be tolerant.  */
+                              free_token (&token);
+                              free_object (&inner);
+                              op->type = t_other;
+                              last_non_comment_line = line_number;
+                              return;
+                            }
                         }
                       /* Unknown # object.  But be tolerant.  */
                       free_token (&token);