Actual source code: str.c

petsc-3.10.5 2019-03-28
Report Typos and Errors

  2: /*
  3:     We define the string operations here. The reason we just do not use
  4:   the standard string routines in the PETSc code is that on some machines
  5:   they are broken or have the wrong prototypes.

  7: */
  8:  #include <petscsys.h>
  9: #if defined(PETSC_HAVE_STRING_H)
 10: #include <string.h>             /* strstr */
 11: #endif
 12: #if defined(PETSC_HAVE_STRINGS_H)
 13: #  include <strings.h>          /* strcasecmp */
 14: #endif

 16: /*@C
 17:    PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings

 19:    Not Collective

 21:    Input Parameters:
 22: +  s - pointer to string
 23: -  sp - separator charactor

 25:    Output Parameter:
 26: +   argc - the number of entries in the array
 27: -   args - an array of the entries with a null at the end

 29:    Level: intermediate

 31:    Notes:
 32:     this may be called before PetscInitialize() or after PetscFinalize()

 34:    Not for use in Fortran

 36:    Developer Notes:
 37:     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
 38:      to generate argc, args arguments passed to MPI_Init()

 40: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()

 42: @*/
 43: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
 44: {
 45:   int       i,j,n,*lens,cnt = 0;
 46:   PetscBool flg = PETSC_FALSE;

 48:   if (!s) n = 0;
 49:   else    n = strlen(s);
 50:   *argc = 0;
 51:   *args = NULL;
 52:   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
 53:     if (s[n-1] != sp) break;
 54:   }
 55:   if (!n) {
 56:     return(0);
 57:   }
 58:   for (i=0; i<n; i++) {
 59:     if (s[i] != sp) break;
 60:   }
 61:   for (;i<n+1; i++) {
 62:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 63:     else if (s[i] != sp) {flg = PETSC_FALSE;}
 64:   }
 65:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 66:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 67:   for (i=0; i<*argc; i++) lens[i] = 0;

 69:   *argc = 0;
 70:   for (i=0; i<n; i++) {
 71:     if (s[i] != sp) break;
 72:   }
 73:   for (;i<n+1; i++) {
 74:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 75:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
 76:   }

 78:   for (i=0; i<*argc; i++) {
 79:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
 80:     if (!(*args)[i]) {
 81:       free(lens);
 82:       for (j=0; j<i; j++) free((*args)[j]);
 83:       free(*args);
 84:       return PETSC_ERR_MEM;
 85:     }
 86:   }
 87:   free(lens);
 88:   (*args)[*argc] = 0;

 90:   *argc = 0;
 91:   for (i=0; i<n; i++) {
 92:     if (s[i] != sp) break;
 93:   }
 94:   for (;i<n+1; i++) {
 95:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
 96:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
 97:   }
 98:   return 0;
 99: }

101: /*@C
102:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

104:    Not Collective

106:    Output Parameters:
107: +  argc - the number of arguments
108: -  args - the array of arguments

110:    Level: intermediate

112:    Concepts: command line arguments

114:    Notes:
115:     This may be called before PetscInitialize() or after PetscFinalize()

117:    Not for use in Fortran

119: .seealso: PetscStrToArray()

121: @*/
122: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
123: {
124:   PetscInt i;

126:   for (i=0; i<argc; i++) free(args[i]);
127:   if (args) free(args);
128:   return 0;
129: }

131: /*@C
132:    PetscStrlen - Gets length of a string

134:    Not Collective

136:    Input Parameters:
137: .  s - pointer to string

139:    Output Parameter:
140: .  len - length in bytes

142:    Level: intermediate

144:    Note:
145:    This routine is analogous to strlen().

147:    Null string returns a length of zero

149:    Not for use in Fortran

151:   Concepts: string length

153: @*/
154: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
155: {
157:   if (!s) *len = 0;
158:   else    *len = strlen(s);
159:   return(0);
160: }

162: /*@C
163:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string

165:    Not Collective

167:    Input Parameters:
168: .  s - pointer to string

170:    Output Parameter:
171: .  t - the copied string

173:    Level: intermediate

175:    Note:
176:       Null string returns a new null string

178:       Not for use in Fortran

180:   Concepts: string copy

182: @*/
183: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
184: {
186:   size_t         len;
187:   char           *tmp = 0;

190:   if (s) {
191:     PetscStrlen(s,&len);
192:     PetscMalloc1(1+len,&tmp);
193:     PetscStrcpy(tmp,s);
194:   }
195:   *t = tmp;
196:   return(0);
197: }

199: /*@C
200:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

202:    Not Collective

204:    Input Parameters:
205: .  s - pointer to array of strings (final string is a null)

207:    Output Parameter:
208: .  t - the copied array string

210:    Level: intermediate

212:    Note:
213:       Not for use in Fortran

215:   Concepts: string copy

217: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

219: @*/
220: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
221: {
223:   PetscInt       i,n = 0;

226:   while (list[n++]) ;
227:   PetscMalloc1(n+1,t);
228:   for (i=0; i<n; i++) {
229:     PetscStrallocpy(list[i],(*t)+i);
230:   }
231:   (*t)[n] = NULL;
232:   return(0);
233: }

235: /*@C
236:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

238:    Not Collective

240:    Output Parameters:
241: .   list - array of strings

243:    Level: intermediate

245:    Concepts: command line arguments

247:    Notes:
248:     Not for use in Fortran

250: .seealso: PetscStrArrayallocpy()

252: @*/
253: PetscErrorCode PetscStrArrayDestroy(char ***list)
254: {
255:   PetscInt       n = 0;

259:   if (!*list) return(0);
260:   while ((*list)[n]) {
261:     PetscFree((*list)[n]);
262:     n++;
263:   }
264:   PetscFree(*list);
265:   return(0);
266: }

268: /*@C
269:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

271:    Not Collective

273:    Input Parameters:
274: +  n - the number of string entries
275: -  s - pointer to array of strings

277:    Output Parameter:
278: .  t - the copied array string

280:    Level: intermediate

282:    Note:
283:       Not for use in Fortran

285:   Concepts: string copy

287: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

289: @*/
290: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
291: {
293:   PetscInt       i;

296:   PetscMalloc1(n,t);
297:   for (i=0; i<n; i++) {
298:     PetscStrallocpy(list[i],(*t)+i);
299:   }
300:   return(0);
301: }

303: /*@C
304:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

306:    Not Collective

308:    Output Parameters:
309: +   n - number of string entries
310: -   list - array of strings

312:    Level: intermediate

314:    Notes:
315:     Not for use in Fortran

317: .seealso: PetscStrArrayallocpy()

319: @*/
320: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
321: {
323:   PetscInt       i;

326:   if (!*list) return(0);
327:   for (i=0; i<n; i++){
328:     PetscFree((*list)[i]);
329:   }
330:   PetscFree(*list);
331:   return(0);
332: }

334: /*@C
335:    PetscStrcpy - Copies a string

337:    Not Collective

339:    Input Parameters:
340: .  t - pointer to string

342:    Output Parameter:
343: .  s - the copied string

345:    Level: intermediate

347:    Notes:
348:      Null string returns a string starting with zero

350:      Not for use in Fortran

352:   Concepts: string copy

354: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()

356: @*/

358: PetscErrorCode  PetscStrcpy(char s[],const char t[])
359: {
361:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
362:   if (t) strcpy(s,t);
363:   else if (s) s[0] = 0;
364:   return(0);
365: }

367: /*@C
368:    PetscStrncpy - Copies a string up to a certain length

370:    Not Collective

372:    Input Parameters:
373: +  t - pointer to string
374: -  n - the length to copy

376:    Output Parameter:
377: .  s - the copied string

379:    Level: intermediate

381:    Note:
382:      Null string returns a string starting with zero

384:      If the string that is being copied is of length n or larger then the entire string is not
385:      copied and the final location of s is set to NULL. This is different then the behavior of 
386:      strncpy() which leaves s non-terminated if there is not room for the entire string.

388:   Concepts: string copy

390:   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()

392: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()

394: @*/
395: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
396: {
398:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
399:   if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
400:   if (t) {
401:     if (n > 1) {
402:       strncpy(s,t,n-1);
403:       s[n-1] = '\0';
404:     } else {
405:       s[0] = '\0';
406:     }
407:   } else if (s) s[0] = 0;
408:   return(0);
409: }

411: /*@C
412:    PetscStrcat - Concatenates a string onto a given string

414:    Not Collective

416:    Input Parameters:
417: +  s - string to be added to
418: -  t - pointer to string to be added to end

420:    Level: intermediate

422:    Notes:
423:     Not for use in Fortran

425:   Concepts: string copy

427: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()

429: @*/
430: PetscErrorCode  PetscStrcat(char s[],const char t[])
431: {
433:   if (!t) return(0);
434:   strcat(s,t);
435:   return(0);
436: }

438: /*@C
439:    PetscStrlcat - Concatenates a string onto a given string, up to a given length

441:    Not Collective

443:    Input Parameters:
444: +  s - pointer to string to be added to at end
445: .  t - string to be added to
446: -  n - length of the original allocated string

448:    Level: intermediate

450:   Notes:
451:   Not for use in Fortran

453:   Unlike the system call strncat(), the length passed in is the length of the
454:   original allocated space, not the length of the left-over space. This is
455:   similar to the BSD system call strlcat().

457:   Concepts: string copy

459: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()

461: @*/
462: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
463: {
464:   size_t         len;

468:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
469:   if (!t) return(0);
470:   PetscStrlen(t,&len);
471:   strncat(s,t,n - len);
472:   s[n-1] = 0;
473:   return(0);
474: }

476: /*

479: */
480: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
481: {
482:   int c;

484:   if (!a && !b)      *flg = PETSC_TRUE;
485:   else if (!a || !b) *flg = PETSC_FALSE;
486:   else {
487:     c = strcmp(a,b);
488:     if (c) *flg = PETSC_FALSE;
489:     else   *flg = PETSC_TRUE;
490:   }
491: }

493: /*@C
494:    PetscStrcmp - Compares two strings,

496:    Not Collective

498:    Input Parameters:
499: +  a - pointer to string first string
500: -  b - pointer to second string

502:    Output Parameter:
503: .  flg - PETSC_TRUE if the two strings are equal

505:    Level: intermediate

507:    Notes:
508:     Not for use in Fortran

510: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()

512: @*/
513: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
514: {
515:   int c;

518:   if (!a && !b)      *flg = PETSC_TRUE;
519:   else if (!a || !b) *flg = PETSC_FALSE;
520:   else {
521:     c = strcmp(a,b);
522:     if (c) *flg = PETSC_FALSE;
523:     else   *flg = PETSC_TRUE;
524:   }
525:   return(0);
526: }

528: /*@C
529:    PetscStrgrt - If first string is greater than the second

531:    Not Collective

533:    Input Parameters:
534: +  a - pointer to first string
535: -  b - pointer to second string

537:    Output Parameter:
538: .  flg - if the first string is greater

540:    Notes:
541:     Null arguments are ok, a null string is considered smaller than
542:     all others

544:    Not for use in Fortran

546:    Level: intermediate

548: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()

550: @*/
551: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
552: {
553:   int c;

556:   if (!a && !b) *t = PETSC_FALSE;
557:   else if (a && !b) *t = PETSC_TRUE;
558:   else if (!a && b) *t = PETSC_FALSE;
559:   else {
560:     c = strcmp(a,b);
561:     if (c > 0) *t = PETSC_TRUE;
562:     else       *t = PETSC_FALSE;
563:   }
564:   return(0);
565: }

567: /*@C
568:    PetscStrcasecmp - Returns true if the two strings are the same
569:      except possibly for case.

571:    Not Collective

573:    Input Parameters:
574: +  a - pointer to first string
575: -  b - pointer to second string

577:    Output Parameter:
578: .  flg - if the two strings are the same

580:    Notes:
581:     Null arguments are ok

583:    Not for use in Fortran

585:    Level: intermediate

587: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()

589: @*/
590: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
591: {
592:   int c;

595:   if (!a && !b) c = 0;
596:   else if (!a || !b) c = 1;
597: #if defined(PETSC_HAVE_STRCASECMP)
598:   else c = strcasecmp(a,b);
599: #elif defined(PETSC_HAVE_STRICMP)
600:   else c = stricmp(a,b);
601: #else
602:   else {
603:     char           *aa,*bb;
605:     PetscStrallocpy(a,&aa);
606:     PetscStrallocpy(b,&bb);
607:     PetscStrtolower(aa);
608:     PetscStrtolower(bb);
609:     PetscStrcmp(aa,bb,t);
610:     PetscFree(aa);
611:     PetscFree(bb);
612:     return(0);
613:   }
614: #endif
615:   if (!c) *t = PETSC_TRUE;
616:   else    *t = PETSC_FALSE;
617:   return(0);
618: }



622: /*@C
623:    PetscStrncmp - Compares two strings, up to a certain length

625:    Not Collective

627:    Input Parameters:
628: +  a - pointer to first string
629: .  b - pointer to second string
630: -  n - length to compare up to

632:    Output Parameter:
633: .  t - if the two strings are equal

635:    Level: intermediate

637:    Notes:
638:     Not for use in Fortran

640: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()

642: @*/
643: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
644: {
645:   int c;

648:   c = strncmp(a,b,n);
649:   if (!c) *t = PETSC_TRUE;
650:   else    *t = PETSC_FALSE;
651:   return(0);
652: }

654: /*@C
655:    PetscStrchr - Locates first occurance of a character in a string

657:    Not Collective

659:    Input Parameters:
660: +  a - pointer to string
661: -  b - character

663:    Output Parameter:
664: .  c - location of occurance, NULL if not found

666:    Level: intermediate

668:    Notes:
669:     Not for use in Fortran

671: @*/
672: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
673: {
675:   *c = (char*)strchr(a,b);
676:   return(0);
677: }

679: /*@C
680:    PetscStrrchr - Locates one location past the last occurance of a character in a string,
681:       if the character is not found then returns entire string

683:    Not Collective

685:    Input Parameters:
686: +  a - pointer to string
687: -  b - character

689:    Output Parameter:
690: .  tmp - location of occurance, a if not found

692:    Level: intermediate

694:    Notes:
695:     Not for use in Fortran

697: @*/
698: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
699: {
701:   *tmp = (char*)strrchr(a,b);
702:   if (!*tmp) *tmp = (char*)a;
703:   else *tmp = *tmp + 1;
704:   return(0);
705: }

707: /*@C
708:    PetscStrtolower - Converts string to lower case

710:    Not Collective

712:    Input Parameters:
713: .  a - pointer to string

715:    Level: intermediate

717:    Notes:
718:     Not for use in Fortran

720: @*/
721: PetscErrorCode  PetscStrtolower(char a[])
722: {
724:   while (*a) {
725:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
726:     a++;
727:   }
728:   return(0);
729: }

731: /*@C
732:    PetscStrtoupper - Converts string to upper case

734:    Not Collective

736:    Input Parameters:
737: .  a - pointer to string

739:    Level: intermediate

741:    Notes:
742:     Not for use in Fortran

744: @*/
745: PetscErrorCode  PetscStrtoupper(char a[])
746: {
748:   while (*a) {
749:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
750:     a++;
751:   }
752:   return(0);
753: }

755: /*@C
756:    PetscStrendswith - Determines if a string ends with a certain string

758:    Not Collective

760:    Input Parameters:
761: +  a - pointer to string
762: -  b - string to endwith

764:    Output Parameter:
765: .  flg - PETSC_TRUE or PETSC_FALSE

767:    Notes:
768:     Not for use in Fortran

770:    Level: intermediate

772: @*/
773: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
774: {
775:   char           *test;
777:   size_t         na,nb;

780:   *flg = PETSC_FALSE;
781:   PetscStrrstr(a,b,&test);
782:   if (test) {
783:     PetscStrlen(a,&na);
784:     PetscStrlen(b,&nb);
785:     if (a+na-nb == test) *flg = PETSC_TRUE;
786:   }
787:   return(0);
788: }

790: /*@C
791:    PetscStrbeginswith - Determines if a string begins with a certain string

793:    Not Collective

795:    Input Parameters:
796: +  a - pointer to string
797: -  b - string to begin with

799:    Output Parameter:
800: .  flg - PETSC_TRUE or PETSC_FALSE

802:    Notes:
803:     Not for use in Fortran

805:    Level: intermediate

807: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
808:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

810: @*/
811: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
812: {
813:   char           *test;

817:   *flg = PETSC_FALSE;
818:   PetscStrrstr(a,b,&test);
819:   if (test && (test == a)) *flg = PETSC_TRUE;
820:   return(0);
821: }


824: /*@C
825:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings

827:    Not Collective

829:    Input Parameters:
830: +  a - pointer to string
831: -  bs - strings to endwith (last entry must be null)

833:    Output Parameter:
834: .  cnt - the index of the string it ends with or 1+the last possible index

836:    Notes:
837:     Not for use in Fortran

839:    Level: intermediate

841: @*/
842: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
843: {
844:   PetscBool      flg;

848:   *cnt = 0;
849:   while (bs[*cnt]) {
850:     PetscStrendswith(a,bs[*cnt],&flg);
851:     if (flg) return(0);
852:     *cnt += 1;
853:   }
854:   return(0);
855: }

857: /*@C
858:    PetscStrrstr - Locates last occurance of string in another string

860:    Not Collective

862:    Input Parameters:
863: +  a - pointer to string
864: -  b - string to find

866:    Output Parameter:
867: .  tmp - location of occurance

869:    Notes:
870:     Not for use in Fortran

872:    Level: intermediate

874: @*/
875: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
876: {
877:   const char *stmp = a, *ltmp = 0;

880:   while (stmp) {
881:     stmp = (char*)strstr(stmp,b);
882:     if (stmp) {ltmp = stmp;stmp++;}
883:   }
884:   *tmp = (char*)ltmp;
885:   return(0);
886: }

888: /*@C
889:    PetscStrstr - Locates first occurance of string in another string

891:    Not Collective

893:    Input Parameters:
894: +  haystack - string to search
895: -  needle - string to find

897:    Output Parameter:
898: .  tmp - location of occurance, is a NULL if the string is not found

900:    Notes:
901:     Not for use in Fortran

903:    Level: intermediate

905: @*/
906: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
907: {
909:   *tmp = (char*)strstr(haystack,needle);
910:   return(0);
911: }

913: struct _p_PetscToken {char token;char *array;char *current;};

915: /*@C
916:    PetscTokenFind - Locates next "token" in a string

918:    Not Collective

920:    Input Parameters:
921: .  a - pointer to token

923:    Output Parameter:
924: .  result - location of occurance, NULL if not found

926:    Notes:

928:      This version is different from the system version in that
929:   it allows you to pass a read-only string into the function.

931:      This version also treats all characters etc. inside a double quote "
932:    as a single token.

934:      For example if the separator character is + and the string is xxxx+y then the first fine will return a pointer to a null terminated xxxx and the 
935:    second will return a null terminated y

937:      If the separator character is + and the string is xxxx then the first and only token found will be a pointer to a null terminated xxxx

939:     Not for use in Fortran

941:    Level: intermediate


944: .seealso: PetscTokenCreate(), PetscTokenDestroy()
945: @*/
946: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
947: {
948:   char *ptr = a->current,token;

951:   *result = a->current;
952:   if (ptr && !*ptr) {*result = 0;return(0);}
953:   token = a->token;
954:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
955:   while (ptr) {
956:     if (*ptr == token) {
957:       *ptr++ = 0;
958:       while (*ptr == a->token) ptr++;
959:       a->current = ptr;
960:       break;
961:     }
962:     if (!*ptr) {
963:       a->current = 0;
964:       break;
965:     }
966:     ptr++;
967:   }
968:   return(0);
969: }

971: /*@C
972:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string

974:    Not Collective

976:    Input Parameters:
977: +  string - the string to look in
978: -  b - the separator character

980:    Output Parameter:
981: .  t- the token object

983:    Notes:

985:      This version is different from the system version in that
986:   it allows you to pass a read-only string into the function.

988:     Not for use in Fortran

990:    Level: intermediate

992: .seealso: PetscTokenFind(), PetscTokenDestroy()
993: @*/
994: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
995: {

999:   PetscNew(t);
1000:   PetscStrallocpy(a,&(*t)->array);

1002:   (*t)->current = (*t)->array;
1003:   (*t)->token   = b;
1004:   return(0);
1005: }

1007: /*@C
1008:    PetscTokenDestroy - Destroys a PetscToken

1010:    Not Collective

1012:    Input Parameters:
1013: .  a - pointer to token

1015:    Level: intermediate

1017:    Notes:
1018:     Not for use in Fortran

1020: .seealso: PetscTokenCreate(), PetscTokenFind()
1021: @*/
1022: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1023: {

1027:   if (!*a) return(0);
1028:   PetscFree((*a)->array);
1029:   PetscFree(*a);
1030:   return(0);
1031: }

1033: /*@C
1034:    PetscStrInList - search string in character-delimited list

1036:    Not Collective

1038:    Input Parameters:
1039: +  str - the string to look for
1040: .  list - the list to search in
1041: -  sep - the separator character

1043:    Output Parameter:
1044: .  found - whether str is in list

1046:    Level: intermediate

1048:    Notes:
1049:     Not for use in Fortran

1051: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1052: @*/
1053: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1054: {
1055:   PetscToken     token;
1056:   char           *item;

1060:   *found = PETSC_FALSE;
1061:   PetscTokenCreate(list,sep,&token);
1062:   PetscTokenFind(token,&item);
1063:   while (item) {
1064:     PetscStrcmp(str,item,found);
1065:     if (*found) break;
1066:     PetscTokenFind(token,&item);
1067:   }
1068:   PetscTokenDestroy(&token);
1069:   return(0);
1070: }

1072: /*@C
1073:    PetscGetPetscDir - Gets the directory PETSc is installed in

1075:    Not Collective

1077:    Output Parameter:
1078: .  dir - the directory

1080:    Level: developer

1082:    Notes:
1083:     Not for use in Fortran

1085: @*/
1086: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1087: {
1089:   *dir = PETSC_DIR;
1090:   return(0);
1091: }

1093: /*@C
1094:    PetscStrreplace - Replaces substrings in string with other substrings

1096:    Not Collective

1098:    Input Parameters:
1099: +   comm - MPI_Comm of processors that are processing the string
1100: .   aa - the string to look in
1101: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1102: -   len - the length of b

1104:    Notes:
1105:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1106:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1107:       as well as any environmental variables.

1109:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1110:       PETSc was built with and do not use environmental variables.

1112:       Not for use in Fortran

1114:    Level: intermediate

1116: @*/
1117: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1118: {
1120:   int            i = 0;
1121:   size_t         l,l1,l2,l3;
1122:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1123:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1124:   char           *r[] = {0,0,0,0,0,0,0,0,0};
1125:   PetscBool      flag;

1128:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1129:   if (aa == b) {
1130:     PetscStrallocpy(aa,(char**)&a);
1131:   }
1132:   PetscMalloc1(len,&work);

1134:   /* get values for replaced variables */
1135:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1136:   PetscStrallocpy(PETSC_DIR,&r[1]);
1137:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1138:   PetscMalloc1(256,&r[3]);
1139:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1140:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1141:   PetscMalloc1(256,&r[6]);
1142:   PetscMalloc1(256,&r[7]);
1143:   PetscGetDisplay(r[3],256);
1144:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1145:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1146:   PetscGetUserName(r[6],256);
1147:   PetscGetHostName(r[7],256);

1149:   /* replace that are in environment */
1150:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1151:   if (flag) {
1152:     PetscFree(r[2]);
1153:     PetscStrallocpy(env,&r[2]);
1154:   }

1156:   /* replace the requested strings */
1157:   PetscStrncpy(b,a,len);
1158:   while (s[i]) {
1159:     PetscStrlen(s[i],&l);
1160:     PetscStrstr(b,s[i],&par);
1161:     while (par) {
1162:       *par =  0;
1163:       par += l;

1165:       PetscStrlen(b,&l1);
1166:       PetscStrlen(r[i],&l2);
1167:       PetscStrlen(par,&l3);
1168:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1169:       PetscStrcpy(work,b);
1170:       PetscStrcat(work,r[i]);
1171:       PetscStrcat(work,par);
1172:       PetscStrncpy(b,work,len);
1173:       PetscStrstr(b,s[i],&par);
1174:     }
1175:     i++;
1176:   }
1177:   i = 0;
1178:   while (r[i]) {
1179:     tfree = (char*)r[i];
1180:     PetscFree(tfree);
1181:     i++;
1182:   }

1184:   /* look for any other ${xxx} strings to replace from environmental variables */
1185:   PetscStrstr(b,"${",&par);
1186:   while (par) {
1187:     *par  = 0;
1188:     par  += 2;
1189:     PetscStrcpy(work,b);
1190:     PetscStrstr(par,"}",&epar);
1191:     *epar = 0;
1192:     epar += 1;
1193:     PetscOptionsGetenv(comm,par,env,256,&flag);
1194:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1195:     PetscStrcat(work,env);
1196:     PetscStrcat(work,epar);
1197:     PetscStrcpy(b,work);
1198:     PetscStrstr(b,"${",&par);
1199:   }
1200:   PetscFree(work);
1201:   if (aa == b) {
1202:     PetscFree(a);
1203:   }
1204:   return(0);
1205: }

1207: /*@C
1208:    PetscEListFind - searches list of strings for given string, using case insensitive matching

1210:    Not Collective

1212:    Input Parameters:
1213: +  n - number of strings in
1214: .  list - list of strings to search
1215: -  str - string to look for, empty string "" accepts default (first entry in list)

1217:    Output Parameters:
1218: +  value - index of matching string (if found)
1219: -  found - boolean indicating whether string was found (can be NULL)

1221:    Notes:
1222:    Not for use in Fortran

1224:    Level: advanced
1225: @*/
1226: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1227: {
1229:   PetscBool matched;
1230:   PetscInt i;

1233:   if (found) *found = PETSC_FALSE;
1234:   for (i=0; i<n; i++) {
1235:     PetscStrcasecmp(str,list[i],&matched);
1236:     if (matched || !str[0]) {
1237:       if (found) *found = PETSC_TRUE;
1238:       *value = i;
1239:       break;
1240:     }
1241:   }
1242:   return(0);
1243: }

1245: /*@C
1246:    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching

1248:    Not Collective

1250:    Input Parameters:
1251: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1252: -  str - string to look for

1254:    Output Parameters:
1255: +  value - index of matching string (if found)
1256: -  found - boolean indicating whether string was found (can be NULL)

1258:    Notes:
1259:    Not for use in Fortran

1261:    Level: advanced
1262: @*/
1263: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1264: {
1266:   PetscInt n = 0,evalue;
1267:   PetscBool efound;

1270:   while (enumlist[n++]) if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1271:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1272:   n -= 3; /* drop enum name, prefix, and null termination */
1273:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1274:   if (efound) *value = (PetscEnum)evalue;
1275:   if (found) *found = efound;
1276:   return(0);
1277: }