/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclscan.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclscan.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 66 by dashley, Sun Oct 30 21:57:38 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
1  /* $Header$ */  /* $Header$ */
2  /*  /*
3   * tclScan.c --   * tclScan.c --
4   *   *
5   *      This file contains the implementation of the "scan" command.   *      This file contains the implementation of the "scan" command.
6   *   *
7   * Copyright (c) 1998 by Scriptics Corporation.   * Copyright (c) 1998 by Scriptics Corporation.
8   *   *
9   * See the file "license.terms" for information on usage and redistribution   * See the file "license.terms" for information on usage and redistribution
10   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11   *   *
12   * RCS: @(#) $Id: tclscan.c,v 1.1.1.1 2001/06/13 04:46:00 dtashley Exp $   * RCS: @(#) $Id: tclscan.c,v 1.1.1.1 2001/06/13 04:46:00 dtashley Exp $
13   */   */
14    
15  #include "tclInt.h"  #include "tclInt.h"
16    
17  /*  /*
18   * Flag values used by Tcl_ScanObjCmd.   * Flag values used by Tcl_ScanObjCmd.
19   */   */
20    
21  #define SCAN_NOSKIP     0x1               /* Don't skip blanks. */  #define SCAN_NOSKIP     0x1               /* Don't skip blanks. */
22  #define SCAN_SUPPRESS   0x2               /* Suppress assignment. */  #define SCAN_SUPPRESS   0x2               /* Suppress assignment. */
23  #define SCAN_UNSIGNED   0x4               /* Read an unsigned value. */  #define SCAN_UNSIGNED   0x4               /* Read an unsigned value. */
24  #define SCAN_WIDTH      0x8               /* A width value was supplied. */  #define SCAN_WIDTH      0x8               /* A width value was supplied. */
25    
26  #define SCAN_SIGNOK     0x10              /* A +/- character is allowed. */  #define SCAN_SIGNOK     0x10              /* A +/- character is allowed. */
27  #define SCAN_NODIGITS   0x20              /* No digits have been scanned. */  #define SCAN_NODIGITS   0x20              /* No digits have been scanned. */
28  #define SCAN_NOZERO     0x40              /* No zero digits have been scanned. */  #define SCAN_NOZERO     0x40              /* No zero digits have been scanned. */
29  #define SCAN_XOK        0x80              /* An 'x' is allowed. */  #define SCAN_XOK        0x80              /* An 'x' is allowed. */
30  #define SCAN_PTOK       0x100             /* Decimal point is allowed. */  #define SCAN_PTOK       0x100             /* Decimal point is allowed. */
31  #define SCAN_EXPOK      0x200             /* An exponent is allowed. */  #define SCAN_EXPOK      0x200             /* An exponent is allowed. */
32    
33    
34  /*  /*
35   * The following structure contains the information associated with   * The following structure contains the information associated with
36   * a character set.   * a character set.
37   */   */
38    
39  typedef struct CharSet {  typedef struct CharSet {
40      int exclude;                /* 1 if this is an exclusion set. */      int exclude;                /* 1 if this is an exclusion set. */
41      int nchars;      int nchars;
42      Tcl_UniChar *chars;      Tcl_UniChar *chars;
43      int nranges;      int nranges;
44      struct Range {      struct Range {
45          Tcl_UniChar start;          Tcl_UniChar start;
46          Tcl_UniChar end;          Tcl_UniChar end;
47      } *ranges;      } *ranges;
48  } CharSet;  } CharSet;
49    
50  /*  /*
51   * Declarations for functions used only in this file.   * Declarations for functions used only in this file.
52   */   */
53    
54  static char *   BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));  static char *   BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format));
55  static int      CharInSet _ANSI_ARGS_((CharSet *cset, int ch));  static int      CharInSet _ANSI_ARGS_((CharSet *cset, int ch));
56  static void     ReleaseCharSet _ANSI_ARGS_((CharSet *cset));  static void     ReleaseCharSet _ANSI_ARGS_((CharSet *cset));
57  static int      ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,  static int      ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format,
58                      int numVars, int *totalVars));                      int numVars, int *totalVars));
59    
60  /*  /*
61   *----------------------------------------------------------------------   *----------------------------------------------------------------------
62   *   *
63   * BuildCharSet --   * BuildCharSet --
64   *   *
65   *      This function examines a character set format specification   *      This function examines a character set format specification
66   *      and builds a CharSet containing the individual characters and   *      and builds a CharSet containing the individual characters and
67   *      character ranges specified.   *      character ranges specified.
68   *   *
69   * Results:   * Results:
70   *      Returns the next format position.   *      Returns the next format position.
71   *   *
72   * Side effects:   * Side effects:
73   *      Initializes the charset.   *      Initializes the charset.
74   *   *
75   *----------------------------------------------------------------------   *----------------------------------------------------------------------
76   */   */
77    
78  static char *  static char *
79  BuildCharSet(cset, format)  BuildCharSet(cset, format)
80      CharSet *cset;      CharSet *cset;
81      char *format;               /* Points to first char of set. */      char *format;               /* Points to first char of set. */
82  {  {
83      Tcl_UniChar ch, start;      Tcl_UniChar ch, start;
84      int offset, nranges;      int offset, nranges;
85      char *end;      char *end;
86    
87      memset(cset, 0, sizeof(CharSet));      memset(cset, 0, sizeof(CharSet));
88            
89      offset = Tcl_UtfToUniChar(format, &ch);      offset = Tcl_UtfToUniChar(format, &ch);
90      if (ch == '^') {      if (ch == '^') {
91          cset->exclude = 1;          cset->exclude = 1;
92          format += offset;          format += offset;
93          offset = Tcl_UtfToUniChar(format, &ch);          offset = Tcl_UtfToUniChar(format, &ch);
94      }      }
95      end = format + offset;      end = format + offset;
96    
97      /*      /*
98       * Find the close bracket so we can overallocate the set.       * Find the close bracket so we can overallocate the set.
99       */       */
100    
101      if (ch == ']') {      if (ch == ']') {
102          end += Tcl_UtfToUniChar(end, &ch);          end += Tcl_UtfToUniChar(end, &ch);
103      }      }
104      nranges = 0;      nranges = 0;
105      while (ch != ']') {      while (ch != ']') {
106          if (ch == '-') {          if (ch == '-') {
107              nranges++;              nranges++;
108          }          }
109          end += Tcl_UtfToUniChar(end, &ch);          end += Tcl_UtfToUniChar(end, &ch);
110      }      }
111    
112      cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)      cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)
113              * (end - format - 1));              * (end - format - 1));
114      if (nranges > 0) {      if (nranges > 0) {
115          cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);          cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
116      } else {      } else {
117          cset->ranges = NULL;          cset->ranges = NULL;
118      }      }
119    
120      /*      /*
121       * Now build the character set.       * Now build the character set.
122       */       */
123    
124      cset->nchars = cset->nranges = 0;      cset->nchars = cset->nranges = 0;
125      format += Tcl_UtfToUniChar(format, &ch);      format += Tcl_UtfToUniChar(format, &ch);
126      start = ch;      start = ch;
127      if (ch == ']' || ch == '-') {      if (ch == ']' || ch == '-') {
128          cset->chars[cset->nchars++] = ch;          cset->chars[cset->nchars++] = ch;
129          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
130      }      }
131      while (ch != ']') {      while (ch != ']') {
132          if (*format == '-') {          if (*format == '-') {
133              /*              /*
134               * This may be the first character of a range, so don't add               * This may be the first character of a range, so don't add
135               * it yet.               * it yet.
136               */               */
137    
138              start = ch;              start = ch;
139          } else if (ch == '-') {          } else if (ch == '-') {
140              /*              /*
141               * Check to see if this is the last character in the set, in which               * Check to see if this is the last character in the set, in which
142               * case it is not a range and we should add the previous character               * case it is not a range and we should add the previous character
143               * as well as the dash.               * as well as the dash.
144               */               */
145    
146              if (*format == ']') {              if (*format == ']') {
147                  cset->chars[cset->nchars++] = start;                  cset->chars[cset->nchars++] = start;
148                  cset->chars[cset->nchars++] = ch;                  cset->chars[cset->nchars++] = ch;
149              } else {              } else {
150                  format += Tcl_UtfToUniChar(format, &ch);                  format += Tcl_UtfToUniChar(format, &ch);
151    
152                  /*                  /*
153                   * Check to see if the range is in reverse order.                   * Check to see if the range is in reverse order.
154                   */                   */
155    
156                  if (start < ch) {                  if (start < ch) {
157                      cset->ranges[cset->nranges].start = start;                      cset->ranges[cset->nranges].start = start;
158                      cset->ranges[cset->nranges].end = ch;                      cset->ranges[cset->nranges].end = ch;
159                  } else {                  } else {
160                      cset->ranges[cset->nranges].start = ch;                      cset->ranges[cset->nranges].start = ch;
161                      cset->ranges[cset->nranges].end = start;                      cset->ranges[cset->nranges].end = start;
162                  }                                    }                  
163                  cset->nranges++;                  cset->nranges++;
164              }              }
165          } else {          } else {
166              cset->chars[cset->nchars++] = ch;              cset->chars[cset->nchars++] = ch;
167          }          }
168          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
169      }      }
170      return format;      return format;
171  }  }
172    
173  /*  /*
174   *----------------------------------------------------------------------   *----------------------------------------------------------------------
175   *   *
176   * CharInSet --   * CharInSet --
177   *   *
178   *      Check to see if a character matches the given set.   *      Check to see if a character matches the given set.
179   *   *
180   * Results:   * Results:
181   *      Returns non-zero if the character matches the given set.   *      Returns non-zero if the character matches the given set.
182   *   *
183   * Side effects:   * Side effects:
184   *      None.   *      None.
185   *   *
186   *----------------------------------------------------------------------   *----------------------------------------------------------------------
187   */   */
188    
189  static int  static int
190  CharInSet(cset, c)  CharInSet(cset, c)
191      CharSet *cset;      CharSet *cset;
192      int c;                      /* Character to test, passed as int because      int c;                      /* Character to test, passed as int because
193                                   * of non-ANSI prototypes. */                                   * of non-ANSI prototypes. */
194  {  {
195      Tcl_UniChar ch = (Tcl_UniChar) c;      Tcl_UniChar ch = (Tcl_UniChar) c;
196      int i, match = 0;      int i, match = 0;
197      for (i = 0; i < cset->nchars; i++) {      for (i = 0; i < cset->nchars; i++) {
198          if (cset->chars[i] == ch) {          if (cset->chars[i] == ch) {
199              match = 1;              match = 1;
200              break;              break;
201          }          }
202      }      }
203      if (!match) {      if (!match) {
204          for (i = 0; i < cset->nranges; i++) {          for (i = 0; i < cset->nranges; i++) {
205              if ((cset->ranges[i].start <= ch)              if ((cset->ranges[i].start <= ch)
206                      && (ch <= cset->ranges[i].end)) {                      && (ch <= cset->ranges[i].end)) {
207                  match = 1;                  match = 1;
208                  break;                  break;
209              }              }
210          }          }
211      }      }
212      return (cset->exclude ? !match : match);          return (cset->exclude ? !match : match);    
213  }  }
214    
215  /*  /*
216   *----------------------------------------------------------------------   *----------------------------------------------------------------------
217   *   *
218   * ReleaseCharSet --   * ReleaseCharSet --
219   *   *
220   *      Free the storage associated with a character set.   *      Free the storage associated with a character set.
221   *   *
222   * Results:   * Results:
223   *      None.   *      None.
224   *   *
225   * Side effects:   * Side effects:
226   *      None.   *      None.
227   *   *
228   *----------------------------------------------------------------------   *----------------------------------------------------------------------
229   */   */
230    
231  static void  static void
232  ReleaseCharSet(cset)  ReleaseCharSet(cset)
233      CharSet *cset;      CharSet *cset;
234  {  {
235      ckfree((char *)cset->chars);      ckfree((char *)cset->chars);
236      if (cset->ranges) {      if (cset->ranges) {
237          ckfree((char *)cset->ranges);          ckfree((char *)cset->ranges);
238      }      }
239  }  }
240    
241  /*  /*
242   *----------------------------------------------------------------------   *----------------------------------------------------------------------
243   *   *
244   * ValidateFormat --   * ValidateFormat --
245   *   *
246   *      Parse the format string and verify that it is properly formed   *      Parse the format string and verify that it is properly formed
247   *      and that there are exactly enough variables on the command line.   *      and that there are exactly enough variables on the command line.
248   *   *
249   * Results:   * Results:
250   *      A standard Tcl result.   *      A standard Tcl result.
251   *   *
252   * Side effects:   * Side effects:
253   *      May place an error in the interpreter result.   *      May place an error in the interpreter result.
254   *   *
255   *----------------------------------------------------------------------   *----------------------------------------------------------------------
256   */   */
257    
258  static int  static int
259  ValidateFormat(interp, format, numVars, totalSubs)  ValidateFormat(interp, format, numVars, totalSubs)
260      Tcl_Interp *interp;         /* Current interpreter. */      Tcl_Interp *interp;         /* Current interpreter. */
261      char *format;               /* The format string. */      char *format;               /* The format string. */
262      int numVars;                /* The number of variables passed to the      int numVars;                /* The number of variables passed to the
263                                   * scan command. */                                   * scan command. */
264      int *totalSubs;             /* The number of variables that will be      int *totalSubs;             /* The number of variables that will be
265                                   * required. */                                   * required. */
266  {  {
267  #define STATIC_LIST_SIZE 16  #define STATIC_LIST_SIZE 16
268      int gotXpg, gotSequential, value, i, flags;      int gotXpg, gotSequential, value, i, flags;
269      char *end;      char *end;
270      Tcl_UniChar ch;      Tcl_UniChar ch;
271      int staticAssign[STATIC_LIST_SIZE];      int staticAssign[STATIC_LIST_SIZE];
272      int *nassign = staticAssign;      int *nassign = staticAssign;
273      int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;      int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
274    
275      /*      /*
276       * Initialize an array that records the number of times a variable       * Initialize an array that records the number of times a variable
277       * is assigned to by the format string.  We use this to detect if       * is assigned to by the format string.  We use this to detect if
278       * a variable is multiply assigned or left unassigned.       * a variable is multiply assigned or left unassigned.
279       */       */
280    
281      if (numVars > nspace) {      if (numVars > nspace) {
282          nassign = (int*)ckalloc(sizeof(int) * numVars);          nassign = (int*)ckalloc(sizeof(int) * numVars);
283          nspace = numVars;          nspace = numVars;
284      }      }
285      for (i = 0; i < nspace; i++) {      for (i = 0; i < nspace; i++) {
286          nassign[i] = 0;          nassign[i] = 0;
287      }      }
288    
289      xpgSize = objIndex = gotXpg = gotSequential = 0;      xpgSize = objIndex = gotXpg = gotSequential = 0;
290    
291      while (*format != '\0') {      while (*format != '\0') {
292          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
293    
294          flags = 0;          flags = 0;
295    
296          if (ch != '%') {          if (ch != '%') {
297              continue;              continue;
298          }          }
299          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
300          if (ch == '%') {          if (ch == '%') {
301              continue;              continue;
302          }          }
303          if (ch == '*') {          if (ch == '*') {
304              flags |= SCAN_SUPPRESS;              flags |= SCAN_SUPPRESS;
305              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
306              goto xpgCheckDone;              goto xpgCheckDone;
307          }          }
308    
309          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
310              /*              /*
311               * Check for an XPG3-style %n$ specification.  Note: there               * Check for an XPG3-style %n$ specification.  Note: there
312               * must not be a mixture of XPG3 specs and non-XPG3 specs               * must not be a mixture of XPG3 specs and non-XPG3 specs
313               * in the same format string.               * in the same format string.
314               */               */
315    
316              value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */              value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
317              if (*end != '$') {              if (*end != '$') {
318                  goto notXpg;                  goto notXpg;
319              }              }
320              format = end+1;              format = end+1;
321              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
322              gotXpg = 1;              gotXpg = 1;
323              if (gotSequential) {              if (gotSequential) {
324                  goto mixedXPG;                  goto mixedXPG;
325              }              }
326              objIndex = value - 1;              objIndex = value - 1;
327              if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {              if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
328                  goto badIndex;                  goto badIndex;
329              } else if (numVars == 0) {              } else if (numVars == 0) {
330                  /*                  /*
331                   * In the case where no vars are specified, the user can                   * In the case where no vars are specified, the user can
332                   * specify %9999$ legally, so we have to consider special                   * specify %9999$ legally, so we have to consider special
333                   * rules for growing the assign array.  'value' is                   * rules for growing the assign array.  'value' is
334                   * guaranteed to be > 0.                   * guaranteed to be > 0.
335                   */                   */
336                  xpgSize = (xpgSize > value) ? xpgSize : value;                  xpgSize = (xpgSize > value) ? xpgSize : value;
337              }              }
338              goto xpgCheckDone;              goto xpgCheckDone;
339          }          }
340    
341          notXpg:          notXpg:
342          gotSequential = 1;          gotSequential = 1;
343          if (gotXpg) {          if (gotXpg) {
344              mixedXPG:              mixedXPG:
345              Tcl_SetResult(interp,              Tcl_SetResult(interp,
346                      "cannot mix \"%\" and \"%n$\" conversion specifiers",                      "cannot mix \"%\" and \"%n$\" conversion specifiers",
347                      TCL_STATIC);                      TCL_STATIC);
348              goto error;              goto error;
349          }          }
350    
351          xpgCheckDone:          xpgCheckDone:
352          /*          /*
353           * Parse any width specifier.           * Parse any width specifier.
354           */           */
355    
356          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
357              value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */              value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
358              flags |= SCAN_WIDTH;              flags |= SCAN_WIDTH;
359              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
360          }          }
361    
362          /*          /*
363           * Ignore size specifier.           * Ignore size specifier.
364           */           */
365    
366          if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {          if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
367              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
368          }          }
369    
370          if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {          if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
371              goto badIndex;              goto badIndex;
372          }          }
373    
374          /*          /*
375           * Handle the various field types.           * Handle the various field types.
376           */           */
377    
378          switch (ch) {          switch (ch) {
379              case 'n':              case 'n':
380              case 'd':              case 'd':
381              case 'i':              case 'i':
382              case 'o':              case 'o':
383              case 'x':              case 'x':
384              case 'u':              case 'u':
385              case 'f':              case 'f':
386              case 'e':              case 'e':
387              case 'g':              case 'g':
388              case 's':              case 's':
389                  break;                  break;
390              case 'c':              case 'c':
391                  if (flags & SCAN_WIDTH) {                  if (flags & SCAN_WIDTH) {
392                      Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC);                      Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC);
393                      goto error;                      goto error;
394                  }                  }
395                  break;                  break;
396              case '[':              case '[':
397                  if (*format == '\0') {                  if (*format == '\0') {
398                      goto badSet;                      goto badSet;
399                  }                  }
400                  format += Tcl_UtfToUniChar(format, &ch);                  format += Tcl_UtfToUniChar(format, &ch);
401                  if (ch == '^') {                  if (ch == '^') {
402                      if (*format == '\0') {                      if (*format == '\0') {
403                          goto badSet;                          goto badSet;
404                      }                      }
405                      format += Tcl_UtfToUniChar(format, &ch);                      format += Tcl_UtfToUniChar(format, &ch);
406                  }                  }
407                  if (ch == ']') {                  if (ch == ']') {
408                      if (*format == '\0') {                      if (*format == '\0') {
409                          goto badSet;                          goto badSet;
410                      }                      }
411                      format += Tcl_UtfToUniChar(format, &ch);                      format += Tcl_UtfToUniChar(format, &ch);
412                  }                  }
413                  while (ch != ']') {                  while (ch != ']') {
414                      if (*format == '\0') {                      if (*format == '\0') {
415                          goto badSet;                          goto badSet;
416                      }                      }
417                      format += Tcl_UtfToUniChar(format, &ch);                      format += Tcl_UtfToUniChar(format, &ch);
418                  }                  }
419                  break;                  break;
420              badSet:              badSet:
421                  Tcl_SetResult(interp, "unmatched [ in format string",                  Tcl_SetResult(interp, "unmatched [ in format string",
422                          TCL_STATIC);                          TCL_STATIC);
423                  goto error;                  goto error;
424              default:              default:
425              {              {
426                  char buf[TCL_UTF_MAX+1];                  char buf[TCL_UTF_MAX+1];
427    
428                  buf[Tcl_UniCharToUtf(ch, buf)] = '\0';                  buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
429                  Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),                  Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
430                          "bad scan conversion character \"", buf, "\"", NULL);                          "bad scan conversion character \"", buf, "\"", NULL);
431                  goto error;                  goto error;
432              }              }
433          }          }
434          if (!(flags & SCAN_SUPPRESS)) {          if (!(flags & SCAN_SUPPRESS)) {
435              if (objIndex >= nspace) {              if (objIndex >= nspace) {
436                  /*                  /*
437                   * Expand the nassign buffer.  If we are using XPG specifiers,                   * Expand the nassign buffer.  If we are using XPG specifiers,
438                   * make sure that we grow to a large enough size.  xpgSize is                   * make sure that we grow to a large enough size.  xpgSize is
439                   * guaranteed to be at least one larger than objIndex.                   * guaranteed to be at least one larger than objIndex.
440                   */                   */
441                  value = nspace;                  value = nspace;
442                  if (xpgSize) {                  if (xpgSize) {
443                      nspace = xpgSize;                      nspace = xpgSize;
444                  } else {                  } else {
445                      nspace += STATIC_LIST_SIZE;                      nspace += STATIC_LIST_SIZE;
446                  }                  }
447                  if (nassign == staticAssign) {                  if (nassign == staticAssign) {
448                      nassign = (void *)ckalloc(nspace * sizeof(int));                      nassign = (void *)ckalloc(nspace * sizeof(int));
449                      for (i = 0; i < STATIC_LIST_SIZE; ++i) {                      for (i = 0; i < STATIC_LIST_SIZE; ++i) {
450                          nassign[i] = staticAssign[i];                          nassign[i] = staticAssign[i];
451                      }                      }
452                  } else {                  } else {
453                      nassign = (void *)ckrealloc((void *)nassign,                      nassign = (void *)ckrealloc((void *)nassign,
454                              nspace * sizeof(int));                              nspace * sizeof(int));
455                  }                  }
456                  for (i = value; i < nspace; i++) {                  for (i = value; i < nspace; i++) {
457                      nassign[i] = 0;                      nassign[i] = 0;
458                  }                  }
459              }              }
460              nassign[objIndex]++;              nassign[objIndex]++;
461              objIndex++;              objIndex++;
462          }          }
463      }      }
464    
465      /*      /*
466       * Verify that all of the variable were assigned exactly once.       * Verify that all of the variable were assigned exactly once.
467       */       */
468    
469      if (numVars == 0) {      if (numVars == 0) {
470          if (xpgSize) {          if (xpgSize) {
471              numVars = xpgSize;              numVars = xpgSize;
472          } else {          } else {
473              numVars = objIndex;              numVars = objIndex;
474          }          }
475      }      }
476      if (totalSubs) {      if (totalSubs) {
477          *totalSubs = numVars;          *totalSubs = numVars;
478      }      }
479      for (i = 0; i < numVars; i++) {      for (i = 0; i < numVars; i++) {
480          if (nassign[i] > 1) {          if (nassign[i] > 1) {
481              Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);              Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
482              goto error;              goto error;
483          } else if (!xpgSize && (nassign[i] == 0)) {          } else if (!xpgSize && (nassign[i] == 0)) {
484              /*              /*
485               * If the space is empty, and xpgSize is 0 (means XPG wasn't               * If the space is empty, and xpgSize is 0 (means XPG wasn't
486               * used, and/or numVars != 0), then too many vars were given               * used, and/or numVars != 0), then too many vars were given
487               */               */
488              Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);              Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
489              goto error;              goto error;
490          }          }
491      }      }
492    
493      if (nassign != staticAssign) {      if (nassign != staticAssign) {
494          ckfree((char *)nassign);          ckfree((char *)nassign);
495      }      }
496      return TCL_OK;      return TCL_OK;
497    
498      badIndex:      badIndex:
499      if (gotXpg) {      if (gotXpg) {
500          Tcl_SetResult(interp, "\"%n$\" argument index out of range",          Tcl_SetResult(interp, "\"%n$\" argument index out of range",
501                  TCL_STATIC);                  TCL_STATIC);
502      } else {      } else {
503          Tcl_SetResult(interp,          Tcl_SetResult(interp,
504                  "different numbers of variable names and field specifiers",                  "different numbers of variable names and field specifiers",
505                  TCL_STATIC);                  TCL_STATIC);
506      }      }
507    
508      error:      error:
509      if (nassign != staticAssign) {      if (nassign != staticAssign) {
510          ckfree((char *)nassign);          ckfree((char *)nassign);
511      }      }
512      return TCL_ERROR;      return TCL_ERROR;
513  #undef STATIC_LIST_SIZE  #undef STATIC_LIST_SIZE
514  }  }
515    
516  /*  /*
517   *----------------------------------------------------------------------   *----------------------------------------------------------------------
518   *   *
519   * Tcl_ScanObjCmd --   * Tcl_ScanObjCmd --
520   *   *
521   *      This procedure is invoked to process the "scan" Tcl command.   *      This procedure is invoked to process the "scan" Tcl command.
522   *      See the user documentation for details on what it does.   *      See the user documentation for details on what it does.
523   *   *
524   * Results:   * Results:
525   *      A standard Tcl result.   *      A standard Tcl result.
526   *   *
527   * Side effects:   * Side effects:
528   *      See the user documentation.   *      See the user documentation.
529   *   *
530   *----------------------------------------------------------------------   *----------------------------------------------------------------------
531   */   */
532    
533          /* ARGSUSED */          /* ARGSUSED */
534  int  int
535  Tcl_ScanObjCmd(dummy, interp, objc, objv)  Tcl_ScanObjCmd(dummy, interp, objc, objv)
536      ClientData dummy;           /* Not used. */      ClientData dummy;           /* Not used. */
537      Tcl_Interp *interp;         /* Current interpreter. */      Tcl_Interp *interp;         /* Current interpreter. */
538      int objc;                   /* Number of arguments. */      int objc;                   /* Number of arguments. */
539      Tcl_Obj *CONST objv[];      /* Argument objects. */      Tcl_Obj *CONST objv[];      /* Argument objects. */
540  {  {
541      char *format;      char *format;
542      int numVars, nconversions, totalVars = -1;      int numVars, nconversions, totalVars = -1;
543      int objIndex, offset, i, value, result, code;      int objIndex, offset, i, value, result, code;
544      char *string, *end, *baseString;      char *string, *end, *baseString;
545      char op = 0;      char op = 0;
546      int base = 0;      int base = 0;
547      int underflow = 0;      int underflow = 0;
548      size_t width;      size_t width;
549      long (*fn)() = NULL;      long (*fn)() = NULL;
550      Tcl_UniChar ch, sch;      Tcl_UniChar ch, sch;
551      Tcl_Obj **objs = NULL, *objPtr = NULL;      Tcl_Obj **objs = NULL, *objPtr = NULL;
552      int flags;      int flags;
553      char buf[513];                        /* Temporary buffer to hold scanned      char buf[513];                        /* Temporary buffer to hold scanned
554                                             * number strings before they are                                             * number strings before they are
555                                             * passed to strtoul. */                                             * passed to strtoul. */
556    
557      if (objc < 3) {      if (objc < 3) {
558          Tcl_WrongNumArgs(interp, 1, objv,          Tcl_WrongNumArgs(interp, 1, objv,
559                  "string format ?varName varName ...?");                  "string format ?varName varName ...?");
560          return TCL_ERROR;          return TCL_ERROR;
561      }      }
562    
563      format = Tcl_GetStringFromObj(objv[2], NULL);      format = Tcl_GetStringFromObj(objv[2], NULL);
564      numVars = objc-3;      numVars = objc-3;
565    
566      /*      /*
567       * Check for errors in the format string.       * Check for errors in the format string.
568       */       */
569            
570      if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {      if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
571          return TCL_ERROR;          return TCL_ERROR;
572      }      }
573    
574      /*      /*
575       * Allocate space for the result objects.       * Allocate space for the result objects.
576       */       */
577    
578      if (totalVars > 0) {      if (totalVars > 0) {
579          objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);          objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
580          for (i = 0; i < totalVars; i++) {          for (i = 0; i < totalVars; i++) {
581              objs[i] = NULL;              objs[i] = NULL;
582          }          }
583      }      }
584    
585      string = Tcl_GetStringFromObj(objv[1], NULL);      string = Tcl_GetStringFromObj(objv[1], NULL);
586      baseString = string;      baseString = string;
587    
588      /*      /*
589       * Iterate over the format string filling in the result objects until       * Iterate over the format string filling in the result objects until
590       * we reach the end of input, the end of the format string, or there       * we reach the end of input, the end of the format string, or there
591       * is a mismatch.       * is a mismatch.
592       */       */
593    
594      objIndex = 0;      objIndex = 0;
595      nconversions = 0;      nconversions = 0;
596      while (*format != '\0') {      while (*format != '\0') {
597          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
598    
599          flags = 0;          flags = 0;
600    
601          /*          /*
602           * If we see whitespace in the format, skip whitespace in the string.           * If we see whitespace in the format, skip whitespace in the string.
603           */           */
604    
605          if (Tcl_UniCharIsSpace(ch)) {          if (Tcl_UniCharIsSpace(ch)) {
606              offset = Tcl_UtfToUniChar(string, &sch);              offset = Tcl_UtfToUniChar(string, &sch);
607              while (Tcl_UniCharIsSpace(sch)) {              while (Tcl_UniCharIsSpace(sch)) {
608                  if (*string == '\0') {                  if (*string == '\0') {
609                      goto done;                      goto done;
610                  }                  }
611                  string += offset;                  string += offset;
612                  offset = Tcl_UtfToUniChar(string, &sch);                  offset = Tcl_UtfToUniChar(string, &sch);
613              }              }
614              continue;              continue;
615          }          }
616                            
617          if (ch != '%') {          if (ch != '%') {
618              literal:              literal:
619              if (*string == '\0') {              if (*string == '\0') {
620                  underflow = 1;                  underflow = 1;
621                  goto done;                  goto done;
622              }              }
623              string += Tcl_UtfToUniChar(string, &sch);              string += Tcl_UtfToUniChar(string, &sch);
624              if (ch != sch) {              if (ch != sch) {
625                  goto done;                  goto done;
626              }              }
627              continue;              continue;
628          }          }
629    
630          format += Tcl_UtfToUniChar(format, &ch);          format += Tcl_UtfToUniChar(format, &ch);
631          if (ch == '%') {          if (ch == '%') {
632              goto literal;              goto literal;
633          }          }
634    
635          /*          /*
636           * Check for assignment suppression ('*') or an XPG3-style           * Check for assignment suppression ('*') or an XPG3-style
637           * assignment ('%n$').           * assignment ('%n$').
638           */           */
639    
640          if (ch == '*') {          if (ch == '*') {
641              flags |= SCAN_SUPPRESS;              flags |= SCAN_SUPPRESS;
642              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
643          } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */          } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
644              value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */              value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
645              if (*end == '$') {              if (*end == '$') {
646                  format = end+1;                  format = end+1;
647                  format += Tcl_UtfToUniChar(format, &ch);                  format += Tcl_UtfToUniChar(format, &ch);
648                  objIndex = value - 1;                  objIndex = value - 1;
649              }              }
650          }          }
651    
652          /*          /*
653           * Parse any width specifier.           * Parse any width specifier.
654           */           */
655    
656          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */          if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
657              width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */              width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
658              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
659          } else {          } else {
660              width = 0;              width = 0;
661          }          }
662    
663          /*          /*
664           * Ignore size specifier.           * Ignore size specifier.
665           */           */
666    
667          if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {          if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
668              format += Tcl_UtfToUniChar(format, &ch);              format += Tcl_UtfToUniChar(format, &ch);
669          }          }
670    
671          /*          /*
672           * Handle the various field types.           * Handle the various field types.
673           */           */
674    
675          switch (ch) {          switch (ch) {
676              case 'n':              case 'n':
677                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
678                      objPtr = Tcl_NewIntObj(string - baseString);                      objPtr = Tcl_NewIntObj(string - baseString);
679                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
680                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
681                  }                  }
682                  nconversions++;                  nconversions++;
683                  continue;                  continue;
684    
685              case 'd':              case 'd':
686                  op = 'i';                  op = 'i';
687                  base = 10;                  base = 10;
688                  fn = (long (*)())strtol;                  fn = (long (*)())strtol;
689                  break;                  break;
690              case 'i':              case 'i':
691                  op = 'i';                  op = 'i';
692                  base = 0;                  base = 0;
693                  fn = (long (*)())strtol;                  fn = (long (*)())strtol;
694                  break;                  break;
695              case 'o':              case 'o':
696                  op = 'i';                  op = 'i';
697                  base = 8;                  base = 8;
698                  fn = (long (*)())strtol;                  fn = (long (*)())strtol;
699                  break;                  break;
700              case 'x':              case 'x':
701                  op = 'i';                  op = 'i';
702                  base = 16;                  base = 16;
703                  fn = (long (*)())strtol;                  fn = (long (*)())strtol;
704                  break;                  break;
705              case 'u':              case 'u':
706                  op = 'i';                  op = 'i';
707                  base = 10;                  base = 10;
708                  flags |= SCAN_UNSIGNED;                  flags |= SCAN_UNSIGNED;
709                  fn = (long (*)())strtoul;                  fn = (long (*)())strtoul;
710                  break;                  break;
711    
712              case 'f':              case 'f':
713              case 'e':              case 'e':
714              case 'g':              case 'g':
715                  op = 'f';                  op = 'f';
716                  break;                  break;
717    
718              case 's':              case 's':
719                  op = 's';                  op = 's';
720                  break;                  break;
721    
722              case 'c':              case 'c':
723                  op = 'c';                  op = 'c';
724                  flags |= SCAN_NOSKIP;                  flags |= SCAN_NOSKIP;
725                  break;                  break;
726              case '[':              case '[':
727                  op = '[';                  op = '[';
728                  flags |= SCAN_NOSKIP;                  flags |= SCAN_NOSKIP;
729                  break;                  break;
730          }          }
731    
732          /*          /*
733           * At this point, we will need additional characters from the           * At this point, we will need additional characters from the
734           * string to proceed.           * string to proceed.
735           */           */
736    
737          if (*string == '\0') {          if (*string == '\0') {
738              underflow = 1;              underflow = 1;
739              goto done;              goto done;
740          }          }
741                    
742          /*          /*
743           * Skip any leading whitespace at the beginning of a field unless           * Skip any leading whitespace at the beginning of a field unless
744           * the format suppresses this behavior.           * the format suppresses this behavior.
745           */           */
746    
747          if (!(flags & SCAN_NOSKIP)) {          if (!(flags & SCAN_NOSKIP)) {
748              while (*string != '\0') {              while (*string != '\0') {
749                  offset = Tcl_UtfToUniChar(string, &sch);                  offset = Tcl_UtfToUniChar(string, &sch);
750                  if (!Tcl_UniCharIsSpace(sch)) {                  if (!Tcl_UniCharIsSpace(sch)) {
751                      break;                      break;
752                  }                  }
753                  string += offset;                  string += offset;
754              }              }
755              if (*string == '\0') {              if (*string == '\0') {
756                  underflow = 1;                  underflow = 1;
757                  goto done;                  goto done;
758              }              }
759          }          }
760    
761          /*          /*
762           * Perform the requested scanning operation.           * Perform the requested scanning operation.
763           */           */
764                    
765          switch (op) {          switch (op) {
766              case 's':              case 's':
767                  /*                  /*
768                   * Scan a string up to width characters or whitespace.                   * Scan a string up to width characters or whitespace.
769                   */                   */
770    
771                  if (width == 0) {                  if (width == 0) {
772                      width = (size_t) ~0;                      width = (size_t) ~0;
773                  }                  }
774                  end = string;                  end = string;
775                  while (*end != '\0') {                  while (*end != '\0') {
776                      offset = Tcl_UtfToUniChar(end, &sch);                      offset = Tcl_UtfToUniChar(end, &sch);
777                      if (Tcl_UniCharIsSpace(sch)) {                      if (Tcl_UniCharIsSpace(sch)) {
778                          break;                          break;
779                      }                      }
780                      end += offset;                      end += offset;
781                      if (--width == 0) {                      if (--width == 0) {
782                          break;                          break;
783                      }                      }
784                  }                  }
785                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
786                      objPtr = Tcl_NewStringObj(string, end-string);                      objPtr = Tcl_NewStringObj(string, end-string);
787                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
788                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
789                  }                  }
790                  string = end;                  string = end;
791                  break;                  break;
792    
793              case '[': {              case '[': {
794                  CharSet cset;                  CharSet cset;
795    
796                  if (width == 0) {                  if (width == 0) {
797                      width = (size_t) ~0;                      width = (size_t) ~0;
798                  }                  }
799                  end = string;                  end = string;
800    
801                  format = BuildCharSet(&cset, format);                  format = BuildCharSet(&cset, format);
802                  while (*end != '\0') {                  while (*end != '\0') {
803                      offset = Tcl_UtfToUniChar(end, &sch);                      offset = Tcl_UtfToUniChar(end, &sch);
804                      if (!CharInSet(&cset, (int)sch)) {                      if (!CharInSet(&cset, (int)sch)) {
805                          break;                          break;
806                      }                      }
807                      end += offset;                      end += offset;
808                      if (--width == 0) {                      if (--width == 0) {
809                          break;                          break;
810                      }                      }
811                  }                  }
812                  ReleaseCharSet(&cset);                  ReleaseCharSet(&cset);
813    
814                  if (string == end) {                  if (string == end) {
815                      /*                      /*
816                       * Nothing matched the range, stop processing                       * Nothing matched the range, stop processing
817                       */                       */
818                      goto done;                      goto done;
819                  }                  }
820                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
821                      objPtr = Tcl_NewStringObj(string, end-string);                      objPtr = Tcl_NewStringObj(string, end-string);
822                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
823                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
824                  }                  }
825                  string = end;                  string = end;
826                                    
827                  break;                  break;
828              }              }
829              case 'c':              case 'c':
830                  /*                  /*
831                   * Scan a single Unicode character.                   * Scan a single Unicode character.
832                   */                   */
833    
834                  string += Tcl_UtfToUniChar(string, &sch);                  string += Tcl_UtfToUniChar(string, &sch);
835                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
836                      objPtr = Tcl_NewIntObj((int)sch);                      objPtr = Tcl_NewIntObj((int)sch);
837                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
838                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
839                  }                  }
840                  break;                  break;
841    
842              case 'i':              case 'i':
843                  /*                  /*
844                   * Scan an unsigned or signed integer.                   * Scan an unsigned or signed integer.
845                   */                   */
846    
847                  if ((width == 0) || (width > sizeof(buf) - 1)) {                  if ((width == 0) || (width > sizeof(buf) - 1)) {
848                      width = sizeof(buf) - 1;                      width = sizeof(buf) - 1;
849                  }                  }
850                  flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;                  flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
851                  for (end = buf; width > 0; width--) {                  for (end = buf; width > 0; width--) {
852                      switch (*string) {                      switch (*string) {
853                          /*                          /*
854                           * The 0 digit has special meaning at the beginning of                           * The 0 digit has special meaning at the beginning of
855                           * a number.  If we are unsure of the base, it                           * a number.  If we are unsure of the base, it
856                           * indicates that we are in base 8 or base 16 (if it is                           * indicates that we are in base 8 or base 16 (if it is
857                           * followed by an 'x').                           * followed by an 'x').
858                           */                           */
859                          case '0':                          case '0':
860                              if (base == 0) {                              if (base == 0) {
861                                  base = 8;                                  base = 8;
862                                  flags |= SCAN_XOK;                                  flags |= SCAN_XOK;
863                              }                              }
864                              if (flags & SCAN_NOZERO) {                              if (flags & SCAN_NOZERO) {
865                                  flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS                                  flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS
866                                          | SCAN_NOZERO);                                          | SCAN_NOZERO);
867                              } else {                              } else {
868                                  flags &= ~(SCAN_SIGNOK | SCAN_XOK                                  flags &= ~(SCAN_SIGNOK | SCAN_XOK
869                                          | SCAN_NODIGITS);                                          | SCAN_NODIGITS);
870                              }                              }
871                              goto addToInt;                              goto addToInt;
872    
873                          case '1': case '2': case '3': case '4':                          case '1': case '2': case '3': case '4':
874                          case '5': case '6': case '7':                          case '5': case '6': case '7':
875                              if (base == 0) {                              if (base == 0) {
876                                  base = 10;                                  base = 10;
877                              }                              }
878                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
879                              goto addToInt;                              goto addToInt;
880    
881                          case '8': case '9':                          case '8': case '9':
882                              if (base == 0) {                              if (base == 0) {
883                                  base = 10;                                  base = 10;
884                              }                              }
885                              if (base <= 8) {                              if (base <= 8) {
886                                  break;                                  break;
887                              }                              }
888                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
889                              goto addToInt;                              goto addToInt;
890    
891                          case 'A': case 'B': case 'C':                          case 'A': case 'B': case 'C':
892                          case 'D': case 'E': case 'F':                          case 'D': case 'E': case 'F':
893                          case 'a': case 'b': case 'c':                          case 'a': case 'b': case 'c':
894                          case 'd': case 'e': case 'f':                          case 'd': case 'e': case 'f':
895                              if (base <= 10) {                              if (base <= 10) {
896                                  break;                                  break;
897                              }                              }
898                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);                              flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS);
899                              goto addToInt;                              goto addToInt;
900    
901                          case '+': case '-':                          case '+': case '-':
902                              if (flags & SCAN_SIGNOK) {                              if (flags & SCAN_SIGNOK) {
903                                  flags &= ~SCAN_SIGNOK;                                  flags &= ~SCAN_SIGNOK;
904                                  goto addToInt;                                  goto addToInt;
905                              }                              }
906                              break;                              break;
907    
908                          case 'x': case 'X':                          case 'x': case 'X':
909                              if ((flags & SCAN_XOK) && (end == buf+1)) {                              if ((flags & SCAN_XOK) && (end == buf+1)) {
910                                  base = 16;                                  base = 16;
911                                  flags &= ~SCAN_XOK;                                  flags &= ~SCAN_XOK;
912                                  goto addToInt;                                  goto addToInt;
913                              }                              }
914                              break;                              break;
915                      }                      }
916    
917                      /*                      /*
918                       * We got an illegal character so we are done accumulating.                       * We got an illegal character so we are done accumulating.
919                       */                       */
920    
921                      break;                      break;
922    
923                      addToInt:                      addToInt:
924                      /*                      /*
925                       * Add the character to the temporary buffer.                       * Add the character to the temporary buffer.
926                       */                       */
927    
928                      *end++ = *string++;                      *end++ = *string++;
929                      if (*string == '\0') {                      if (*string == '\0') {
930                          break;                          break;
931                      }                      }
932                  }                  }
933    
934                  /*                  /*
935                   * Check to see if we need to back up because we only got a                   * Check to see if we need to back up because we only got a
936                   * sign or a trailing x after a 0.                   * sign or a trailing x after a 0.
937                   */                   */
938    
939                  if (flags & SCAN_NODIGITS) {                  if (flags & SCAN_NODIGITS) {
940                      if (*string == '\0') {                      if (*string == '\0') {
941                          underflow = 1;                          underflow = 1;
942                      }                      }
943                      goto done;                      goto done;
944                  } else if (end[-1] == 'x' || end[-1] == 'X') {                  } else if (end[-1] == 'x' || end[-1] == 'X') {
945                      end--;                      end--;
946                      string--;                      string--;
947                  }                  }
948    
949    
950                  /*                  /*
951                   * Scan the value from the temporary buffer.  If we are                   * Scan the value from the temporary buffer.  If we are
952                   * returning a large unsigned value, we have to convert it back                   * returning a large unsigned value, we have to convert it back
953                   * to a string since Tcl only supports signed values.                   * to a string since Tcl only supports signed values.
954                   */                   */
955    
956                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
957                      *end = '\0';                      *end = '\0';
958                      value = (int) (*fn)(buf, NULL, base);                      value = (int) (*fn)(buf, NULL, base);
959                      if ((flags & SCAN_UNSIGNED) && (value < 0)) {                      if ((flags & SCAN_UNSIGNED) && (value < 0)) {
960                          sprintf(buf, "%u", value); /* INTL: ISO digit */                          sprintf(buf, "%u", value); /* INTL: ISO digit */
961                          objPtr = Tcl_NewStringObj(buf, -1);                          objPtr = Tcl_NewStringObj(buf, -1);
962                      } else {                      } else {
963                          objPtr = Tcl_NewIntObj(value);                          objPtr = Tcl_NewIntObj(value);
964                      }                      }
965                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
966                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
967                  }                  }
968    
969                  break;                  break;
970    
971              case 'f':              case 'f':
972                  /*                  /*
973                   * Scan a floating point number                   * Scan a floating point number
974                   */                   */
975    
976                  if ((width == 0) || (width > sizeof(buf) - 1)) {                  if ((width == 0) || (width > sizeof(buf) - 1)) {
977                      width = sizeof(buf) - 1;                      width = sizeof(buf) - 1;
978                  }                  }
979                  flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;                  flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
980                  for (end = buf; width > 0; width--) {                  for (end = buf; width > 0; width--) {
981                      switch (*string) {                      switch (*string) {
982                          case '0': case '1': case '2': case '3':                          case '0': case '1': case '2': case '3':
983                          case '4': case '5': case '6': case '7':                          case '4': case '5': case '6': case '7':
984                          case '8': case '9':                          case '8': case '9':
985                              flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);                              flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
986                              goto addToFloat;                              goto addToFloat;
987                          case '+': case '-':                          case '+': case '-':
988                              if (flags & SCAN_SIGNOK) {                              if (flags & SCAN_SIGNOK) {
989                                  flags &= ~SCAN_SIGNOK;                                  flags &= ~SCAN_SIGNOK;
990                                  goto addToFloat;                                  goto addToFloat;
991                              }                              }
992                              break;                              break;
993                          case '.':                          case '.':
994                              if (flags & SCAN_PTOK) {                              if (flags & SCAN_PTOK) {
995                                  flags &= ~(SCAN_SIGNOK | SCAN_PTOK);                                  flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
996                                  goto addToFloat;                                  goto addToFloat;
997                              }                              }
998                              break;                              break;
999                          case 'e': case 'E':                          case 'e': case 'E':
1000                              /*                              /*
1001                               * An exponent is not allowed until there has                               * An exponent is not allowed until there has
1002                               * been at least one digit.                               * been at least one digit.
1003                               */                               */
1004    
1005                              if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))                              if ((flags & (SCAN_NODIGITS | SCAN_EXPOK))
1006                                      == SCAN_EXPOK) {                                      == SCAN_EXPOK) {
1007                                  flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))                                  flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
1008                                      | SCAN_SIGNOK | SCAN_NODIGITS;                                      | SCAN_SIGNOK | SCAN_NODIGITS;
1009                                  goto addToFloat;                                  goto addToFloat;
1010                              }                              }
1011                              break;                              break;
1012                      }                      }
1013    
1014                      /*                      /*
1015                       * We got an illegal character so we are done accumulating.                       * We got an illegal character so we are done accumulating.
1016                       */                       */
1017    
1018                      break;                      break;
1019    
1020                      addToFloat:                      addToFloat:
1021                      /*                      /*
1022                       * Add the character to the temporary buffer.                       * Add the character to the temporary buffer.
1023                       */                       */
1024    
1025                      *end++ = *string++;                      *end++ = *string++;
1026                      if (*string == '\0') {                      if (*string == '\0') {
1027                          break;                          break;
1028                      }                      }
1029                  }                  }
1030    
1031                  /*                  /*
1032                   * Check to see if we need to back up because we saw a                   * Check to see if we need to back up because we saw a
1033                   * trailing 'e' or sign.                   * trailing 'e' or sign.
1034                   */                   */
1035    
1036                  if (flags & SCAN_NODIGITS) {                  if (flags & SCAN_NODIGITS) {
1037                      if (flags & SCAN_EXPOK) {                      if (flags & SCAN_EXPOK) {
1038                          /*                          /*
1039                           * There were no digits at all so scanning has                           * There were no digits at all so scanning has
1040                           * failed and we are done.                           * failed and we are done.
1041                           */                           */
1042                          if (*string == '\0') {                          if (*string == '\0') {
1043                              underflow = 1;                              underflow = 1;
1044                          }                          }
1045                          goto done;                          goto done;
1046                      }                      }
1047    
1048                      /*                      /*
1049                       * We got a bad exponent ('e' and maybe a sign).                       * We got a bad exponent ('e' and maybe a sign).
1050                       */                       */
1051    
1052                      end--;                      end--;
1053                      string--;                      string--;
1054                      if (*end != 'e' && *end != 'E') {                      if (*end != 'e' && *end != 'E') {
1055                          end--;                          end--;
1056                          string--;                          string--;
1057                      }                      }
1058                  }                  }
1059    
1060                  /*                  /*
1061                   * Scan the value from the temporary buffer.                   * Scan the value from the temporary buffer.
1062                   */                   */
1063    
1064                  if (!(flags & SCAN_SUPPRESS)) {                  if (!(flags & SCAN_SUPPRESS)) {
1065                      double dvalue;                      double dvalue;
1066                      *end = '\0';                      *end = '\0';
1067                      dvalue = strtod(buf, NULL);                      dvalue = strtod(buf, NULL);
1068                      objPtr = Tcl_NewDoubleObj(dvalue);                      objPtr = Tcl_NewDoubleObj(dvalue);
1069                      Tcl_IncrRefCount(objPtr);                      Tcl_IncrRefCount(objPtr);
1070                      objs[objIndex++] = objPtr;                      objs[objIndex++] = objPtr;
1071                  }                  }
1072                  break;                  break;
1073          }          }
1074          nconversions++;          nconversions++;
1075      }      }
1076    
1077      done:      done:
1078      result = 0;      result = 0;
1079      code = TCL_OK;      code = TCL_OK;
1080    
1081      if (numVars) {      if (numVars) {
1082          /*          /*
1083           * In this case, variables were specified (classic scan)           * In this case, variables were specified (classic scan)
1084           */           */
1085          for (i = 0; i < totalVars; i++) {          for (i = 0; i < totalVars; i++) {
1086              if (objs[i] != NULL) {              if (objs[i] != NULL) {
1087                  result++;                  result++;
1088                  if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,                  if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,
1089                          objs[i], 0) == NULL) {                          objs[i], 0) == NULL) {
1090                      Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),                      Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1091                              "couldn't set variable \"",                              "couldn't set variable \"",
1092                              Tcl_GetString(objv[i+3]), "\"", (char *) NULL);                              Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
1093                      code = TCL_ERROR;                      code = TCL_ERROR;
1094                  }                  }
1095                  Tcl_DecrRefCount(objs[i]);                  Tcl_DecrRefCount(objs[i]);
1096              }              }
1097          }          }
1098      } else {      } else {
1099          /*          /*
1100           * Here no vars were specified, we want a list returned (inline scan)           * Here no vars were specified, we want a list returned (inline scan)
1101           */           */
1102          objPtr = Tcl_NewObj();          objPtr = Tcl_NewObj();
1103          for (i = 0; i < totalVars; i++) {          for (i = 0; i < totalVars; i++) {
1104              if (objs[i] != NULL) {              if (objs[i] != NULL) {
1105                  Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);                  Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
1106                  Tcl_DecrRefCount(objs[i]);                  Tcl_DecrRefCount(objs[i]);
1107              } else {              } else {
1108                  /*                  /*
1109                   * More %-specifiers than matching chars, so we                   * More %-specifiers than matching chars, so we
1110                   * just spit out empty strings for these                   * just spit out empty strings for these
1111                   */                   */
1112                  Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());                  Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
1113              }              }
1114          }          }
1115      }      }
1116      ckfree((char*) objs);      ckfree((char*) objs);
1117      if (code == TCL_OK) {      if (code == TCL_OK) {
1118          if (underflow && (nconversions == 0)) {          if (underflow && (nconversions == 0)) {
1119              if (numVars) {              if (numVars) {
1120                  objPtr = Tcl_NewIntObj(-1);                  objPtr = Tcl_NewIntObj(-1);
1121              } else {              } else {
1122                  if (objPtr) {                  if (objPtr) {
1123                      Tcl_SetListObj(objPtr, 0, NULL);                      Tcl_SetListObj(objPtr, 0, NULL);
1124                  } else {                  } else {
1125                      objPtr = Tcl_NewObj();                      objPtr = Tcl_NewObj();
1126                  }                  }
1127              }              }
1128          } else if (numVars) {          } else if (numVars) {
1129              objPtr = Tcl_NewIntObj(result);              objPtr = Tcl_NewIntObj(result);
1130          }          }
1131          Tcl_SetObjResult(interp, objPtr);          Tcl_SetObjResult(interp, objPtr);
1132      }      }
1133      return code;      return code;
1134  }  }
1135    
1136  /* End of tclscan.c */  /* End of tclscan.c */
Legend:
Removed from v.66  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25