Actual source code: str.c

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

      6: */
      7: #include <petsc/private/petscimpl.h>
      8: #if defined(PETSC_HAVE_STRINGS_H)
      9: #  include <strings.h>          /* strcasecmp */
     10: #endif

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

     15:    Not Collective

     17:    Input Parameters:
     18: +  s - pointer to string
     19: -  sp - separator character

     21:    Output Parameters:
     22: +   argc - the number of entries in the array
     23: -   args - an array of the entries with a null at the end

     25:    Level: intermediate

     27:    Notes:
     28:     this may be called before PetscInitialize() or after PetscFinalize()

     30:    Not for use in Fortran

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

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

     38: @*/
     39: PetscErrorCode PetscStrToArray(const char s[], char sp, int *argc, char ***args)
     40: {
     41:   int       i,j,n,*lens,cnt = 0;
     42:   PetscBool flg = PETSC_FALSE;

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

     63:   *argc = 0;
     64:   for (i=0; i<n; i++) {
     65:     if (s[i] != sp) break;
     66:   }
     67:   for (;i<n+1; i++) {
     68:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     69:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
     70:   }

     72:   for (i=0; i<*argc; i++) {
     73:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
     74:     if (!(*args)[i]) {
     75:       free(lens);
     76:       for (j=0; j<i; j++) free((*args)[j]);
     77:       free(*args);
     78:       return PETSC_ERR_MEM;
     79:     }
     80:   }
     81:   free(lens);
     82:   (*args)[*argc] = NULL;

     84:   *argc = 0;
     85:   for (i=0; i<n; i++) {
     86:     if (s[i] != sp) break;
     87:   }
     88:   for (;i<n+1; i++) {
     89:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
     90:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
     91:   }
     92:   return 0;
     93: }

     95: /*@C
     96:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

     98:    Not Collective

    100:    Output Parameters:
    101: +  argc - the number of arguments
    102: -  args - the array of arguments

    104:    Level: intermediate

    106:    Notes:
    107:     This may be called before PetscInitialize() or after PetscFinalize()

    109:    Not for use in Fortran

    111: .seealso: PetscStrToArray()

    113: @*/
    114: PetscErrorCode PetscStrToArrayDestroy(int argc, char **args)
    115: {
    116:   for (int i = 0; i < argc; ++i) free(args[i]);
    117:   if (args) free(args);
    118:   return 0;
    119: }

    121: /*@C
    122:    PetscStrlen - Gets length of a string

    124:    Not Collective

    126:    Input Parameters:
    127: .  s - pointer to string

    129:    Output Parameter:
    130: .  len - length in bytes

    132:    Level: intermediate

    134:    Note:
    135:    This routine is analogous to strlen().

    137:    Null string returns a length of zero

    139:    Not for use in Fortran

    141: @*/
    142: PetscErrorCode PetscStrlen(const char s[], size_t *len)
    143: {
    144:   *len = s ? strlen(s) : 0;
    145:   return 0;
    146: }

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

    151:    Not Collective

    153:    Input Parameters:
    154: .  s - pointer to string

    156:    Output Parameter:
    157: .  t - the copied string

    159:    Level: intermediate

    161:    Note:
    162:       Null string returns a new null string

    164:       Not for use in Fortran

    166:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscFree()
    167:       the array before calling this routine.

    169: .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()

    171: @*/
    172: PetscErrorCode PetscStrallocpy(const char s[], char *t[])
    173: {
    174:   char *tmp = NULL;

    176:   if (s) {
    177:     size_t len;

    179:     PetscStrlen(s,&len);
    180:     PetscMalloc1(1+len,&tmp);
    181:     PetscStrcpy(tmp,s);
    182:   }
    183:   *t = tmp;
    184:   return 0;
    185: }

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

    190:    Not Collective

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

    195:    Output Parameter:
    196: .  t - the copied array string

    198:    Level: intermediate

    200:    Note:
    201:       Not for use in Fortran

    203:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
    204:       the array before calling this routine.

    206: .seealso: PetscStrallocpy(), PetscStrArrayDestroy(), PetscStrNArrayallocpy()

    208: @*/
    209: PetscErrorCode PetscStrArrayallocpy(const char *const *list, char ***t)
    210: {
    211:   PetscInt n = 0;

    213:   while (list[n++]) ;
    214:   PetscMalloc1(n+1,t);
    215:   for (PetscInt i=0; i<n; i++) PetscStrallocpy(list[i],(*t)+i);
    216:   (*t)[n] = NULL;
    217:   return 0;
    218: }

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

    223:    Not Collective

    225:    Output Parameters:
    226: .   list - array of strings

    228:    Level: intermediate

    230:    Notes:
    231:     Not for use in Fortran

    233: .seealso: PetscStrArrayallocpy()

    235: @*/
    236: PetscErrorCode PetscStrArrayDestroy(char ***list)
    237: {
    238:   PetscInt n = 0;

    240:   if (!*list) return 0;
    241:   while ((*list)[n]) {
    242:     PetscFree((*list)[n]);
    243:     ++n;
    244:   }
    245:   PetscFree(*list);
    246:   return 0;
    247: }

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

    252:    Not Collective

    254:    Input Parameters:
    255: +  n - the number of string entries
    256: -  s - pointer to array of strings

    258:    Output Parameter:
    259: .  t - the copied array string

    261:    Level: intermediate

    263:    Note:
    264:       Not for use in Fortran

    266: .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()

    268: @*/
    269: PetscErrorCode PetscStrNArrayallocpy(PetscInt n, const char *const *list, char ***t)
    270: {
    271:   PetscMalloc1(n,t);
    272:   for (PetscInt i=0; i<n; i++) PetscStrallocpy(list[i],(*t)+i);
    273:   return 0;
    274: }

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

    279:    Not Collective

    281:    Output Parameters:
    282: +   n - number of string entries
    283: -   list - array of strings

    285:    Level: intermediate

    287:    Notes:
    288:     Not for use in Fortran

    290: .seealso: PetscStrArrayallocpy()

    292: @*/
    293: PetscErrorCode PetscStrNArrayDestroy(PetscInt n, char ***list)
    294: {
    295:   if (!*list) return 0;
    296:   for (PetscInt i=0; i<n; i++) PetscFree((*list)[i]);
    297:   PetscFree(*list);
    298:   return 0;
    299: }

    301: /*@C
    302:    PetscStrcpy - Copies a string

    304:    Not Collective

    306:    Input Parameters:
    307: .  t - pointer to string

    309:    Output Parameter:
    310: .  s - the copied string

    312:    Level: intermediate

    314:    Notes:
    315:      Null string returns a string starting with zero

    317:      Not for use in Fortran

    319:      It is recommended you use PetscStrncpy() instead of this routine

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

    323: @*/

    325: PetscErrorCode PetscStrcpy(char s[], const char t[])
    326: {
    327:   if (t) {
    330:     strcpy(s,t);
    331:   } else if (s) s[0] = 0;
    332:   return 0;
    333: }

    335: /*@C
    336:    PetscStrncpy - Copies a string up to a certain length

    338:    Not Collective

    340:    Input Parameters:
    341: +  t - pointer to string
    342: -  n - the length to copy

    344:    Output Parameter:
    345: .  s - the copied string

    347:    Level: intermediate

    349:    Note:
    350:      Null string returns a string starting with zero

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

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

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

    360: @*/
    361: PetscErrorCode PetscStrncpy(char s[], const char t[], size_t n)
    362: {
    364:   if (t) {
    366:     if (n > 1) {
    367:       strncpy(s,t,n-1);
    368:       s[n-1] = '\0';
    369:     } else {
    370:       s[0] = '\0';
    371:     }
    372:   } else if (s) s[0] = 0;
    373:   return 0;
    374: }

    376: /*@C
    377:    PetscStrcat - Concatenates a string onto a given string

    379:    Not Collective

    381:    Input Parameters:
    382: +  s - string to be added to
    383: -  t - pointer to string to be added to end

    385:    Level: intermediate

    387:    Notes:
    388:     Not for use in Fortran

    390:     It is recommended you use PetscStrlcat() instead of this routine

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

    394: @*/
    395: PetscErrorCode PetscStrcat(char s[], const char t[])
    396: {
    397:   if (!t) return 0;
    400:   strcat(s,t);
    401:   return 0;
    402: }

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

    407:    Not Collective

    409:    Input Parameters:
    410: +  s - pointer to string to be added to at end
    411: .  t - string to be added
    412: -  n - length of the original allocated string

    414:    Level: intermediate

    416:   Notes:
    417:   Not for use in Fortran

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

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

    425: @*/
    426: PetscErrorCode PetscStrlcat(char s[], const char t[], size_t n)
    427: {
    428:   size_t len;

    430:   if (!t) return 0;
    434:   PetscStrlen(t,&len);
    435:   strncat(s,t,n - len);
    436:   s[n-1] = 0;
    437:   return 0;
    438: }

    440: void PetscStrcmpNoError(const char a[], const char b[], PetscBool *flg)
    441: {
    442:   if (!a && !b)      *flg = PETSC_TRUE;
    443:   else if (!a || !b) *flg = PETSC_FALSE;
    444:   else *flg = strcmp(a,b) ? PETSC_FALSE : PETSC_TRUE;
    445: }

    447: /*@C
    448:    PetscStrcmp - Compares two strings,

    450:    Not Collective

    452:    Input Parameters:
    453: +  a - pointer to string first string
    454: -  b - pointer to second string

    456:    Output Parameter:
    457: .  flg - PETSC_TRUE if the two strings are equal

    459:    Level: intermediate

    461:    Notes:
    462:     Not for use in Fortran

    464: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
    465: @*/
    466: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool *flg)
    467: {
    469:   if (!a && !b)      *flg = PETSC_TRUE;
    470:   else if (!a || !b) *flg = PETSC_FALSE;
    471:   else               *flg = (PetscBool)!strcmp(a,b);
    472:   return 0;
    473: }

    475: /*@C
    476:    PetscStrgrt - If first string is greater than the second

    478:    Not Collective

    480:    Input Parameters:
    481: +  a - pointer to first string
    482: -  b - pointer to second string

    484:    Output Parameter:
    485: .  flg - if the first string is greater

    487:    Notes:
    488:     Null arguments are ok, a null string is considered smaller than
    489:     all others

    491:    Not for use in Fortran

    493:    Level: intermediate

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

    497: @*/
    498: PetscErrorCode PetscStrgrt(const char a[], const char b[], PetscBool *t)
    499: {
    501:   if (!a && !b)     *t = PETSC_FALSE;
    502:   else if (a && !b) *t = PETSC_TRUE;
    503:   else if (!a && b) *t = PETSC_FALSE;
    504:   else {
    507:     *t = strcmp(a,b) > 0 ? PETSC_TRUE : PETSC_FALSE;
    508:   }
    509:   return 0;
    510: }

    512: /*@C
    513:    PetscStrcasecmp - Returns true if the two strings are the same
    514:      except possibly for case.

    516:    Not Collective

    518:    Input Parameters:
    519: +  a - pointer to first string
    520: -  b - pointer to second string

    522:    Output Parameter:
    523: .  flg - if the two strings are the same

    525:    Notes:
    526:     Null arguments are ok

    528:    Not for use in Fortran

    530:    Level: intermediate

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

    534: @*/
    535: PetscErrorCode PetscStrcasecmp(const char a[], const char b[], PetscBool *t)
    536: {
    537:   int c;

    540:   if (!a && !b)      c = 0;
    541:   else if (!a || !b) c = 1;
    542: #if defined(PETSC_HAVE_STRCASECMP)
    543:   else c = strcasecmp(a,b);
    544: #elif defined(PETSC_HAVE_STRICMP)
    545:   else c = stricmp(a,b);
    546: #else
    547:   else {
    548:     char           *aa,*bb;
    549:     PetscStrallocpy(a,&aa);
    550:     PetscStrallocpy(b,&bb);
    551:     PetscStrtolower(aa);
    552:     PetscStrtolower(bb);
    553:     PetscStrcmp(aa,bb,t);
    554:     PetscFree(aa);
    555:     PetscFree(bb);
    556:     return 0;
    557:   }
    558: #endif
    559:   *t = c ? PETSC_FALSE : PETSC_TRUE;
    560:   return 0;
    561: }

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

    566:    Not Collective

    568:    Input Parameters:
    569: +  a - pointer to first string
    570: .  b - pointer to second string
    571: -  n - length to compare up to

    573:    Output Parameter:
    574: .  t - if the two strings are equal

    576:    Level: intermediate

    578:    Notes:
    579:     Not for use in Fortran

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

    583: @*/
    584: PetscErrorCode PetscStrncmp(const char a[], const char b[], size_t n, PetscBool *t)
    585: {
    586:   if (n) {
    589:   }
    591:   *t = strncmp(a,b,n) ? PETSC_FALSE : PETSC_TRUE;
    592:   return 0;
    593: }

    595: /*@C
    596:    PetscStrchr - Locates first occurrence of a character in a string

    598:    Not Collective

    600:    Input Parameters:
    601: +  a - pointer to string
    602: -  b - character

    604:    Output Parameter:
    605: .  c - location of occurrence, NULL if not found

    607:    Level: intermediate

    609:    Notes:
    610:     Not for use in Fortran

    612: @*/
    613: PetscErrorCode PetscStrchr(const char a[], char b, char *c[])
    614: {
    617:   *c = (char*)strchr(a,b);
    618:   return 0;
    619: }

    621: /*@C
    622:    PetscStrrchr - Locates one location past the last occurrence of a character in a string,
    623:       if the character is not found then returns entire string

    625:    Not Collective

    627:    Input Parameters:
    628: +  a - pointer to string
    629: -  b - character

    631:    Output Parameter:
    632: .  tmp - location of occurrence, a if not found

    634:    Level: intermediate

    636:    Notes:
    637:     Not for use in Fortran

    639: @*/
    640: PetscErrorCode PetscStrrchr(const char a[], char b, char *tmp[])
    641: {
    644:   *tmp = (char*)strrchr(a,b);
    645:   if (!*tmp) *tmp = (char*)a;
    646:   else *tmp = *tmp + 1;
    647:   return 0;
    648: }

    650: /*@C
    651:    PetscStrtolower - Converts string to lower case

    653:    Not Collective

    655:    Input Parameters:
    656: .  a - pointer to string

    658:    Level: intermediate

    660:    Notes:
    661:     Not for use in Fortran

    663: @*/
    664: PetscErrorCode PetscStrtolower(char a[])
    665: {
    667:   while (*a) {
    668:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
    669:     a++;
    670:   }
    671:   return 0;
    672: }

    674: /*@C
    675:    PetscStrtoupper - Converts string to upper case

    677:    Not Collective

    679:    Input Parameters:
    680: .  a - pointer to string

    682:    Level: intermediate

    684:    Notes:
    685:     Not for use in Fortran

    687: @*/
    688: PetscErrorCode PetscStrtoupper(char a[])
    689: {
    691:   while (*a) {
    692:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
    693:     a++;
    694:   }
    695:   return 0;
    696: }

    698: /*@C
    699:    PetscStrendswith - Determines if a string ends with a certain string

    701:    Not Collective

    703:    Input Parameters:
    704: +  a - pointer to string
    705: -  b - string to endwith

    707:    Output Parameter:
    708: .  flg - PETSC_TRUE or PETSC_FALSE

    710:    Notes:
    711:     Not for use in Fortran

    713:    Level: intermediate

    715: @*/
    716: PetscErrorCode PetscStrendswith(const char a[], const char b[], PetscBool *flg)
    717: {
    718:   char *test;

    721:   *flg = PETSC_FALSE;
    722:   PetscStrrstr(a,b,&test);
    723:   if (test) {
    724:     size_t na,nb;

    726:     PetscStrlen(a,&na);
    727:     PetscStrlen(b,&nb);
    728:     if (a+na-nb == test) *flg = PETSC_TRUE;
    729:   }
    730:   return 0;
    731: }

    733: /*@C
    734:    PetscStrbeginswith - Determines if a string begins with a certain string

    736:    Not Collective

    738:    Input Parameters:
    739: +  a - pointer to string
    740: -  b - string to begin with

    742:    Output Parameter:
    743: .  flg - PETSC_TRUE or PETSC_FALSE

    745:    Notes:
    746:     Not for use in Fortran

    748:    Level: intermediate

    750: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
    751:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

    753: @*/
    754: PetscErrorCode PetscStrbeginswith(const char a[], const char b[], PetscBool *flg)
    755: {
    756:   char *test;

    761:   *flg = PETSC_FALSE;
    762:   PetscStrrstr(a,b,&test);
    763:   if (test && (test == a)) *flg = PETSC_TRUE;
    764:   return 0;
    765: }

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

    770:    Not Collective

    772:    Input Parameters:
    773: +  a - pointer to string
    774: -  bs - strings to end with (last entry must be NULL)

    776:    Output Parameter:
    777: .  cnt - the index of the string it ends with or the index of NULL

    779:    Notes:
    780:     Not for use in Fortran

    782:    Level: intermediate

    784: @*/
    785: PetscErrorCode PetscStrendswithwhich(const char a[], const char *const *bs, PetscInt *cnt)
    786: {
    789:   *cnt = 0;
    790:   while (bs[*cnt]) {
    791:     PetscBool flg;

    793:     PetscStrendswith(a,bs[*cnt],&flg);
    794:     if (flg) return 0;
    795:     ++(*cnt);
    796:   }
    797:   return 0;
    798: }

    800: /*@C
    801:    PetscStrrstr - Locates last occurrence of string in another string

    803:    Not Collective

    805:    Input Parameters:
    806: +  a - pointer to string
    807: -  b - string to find

    809:    Output Parameter:
    810: .  tmp - location of occurrence

    812:    Notes:
    813:     Not for use in Fortran

    815:    Level: intermediate

    817: @*/
    818: PetscErrorCode PetscStrrstr(const char a[], const char b[], char *tmp[])
    819: {
    820:   const char *ltmp = NULL;

    825:   while (a) {
    826:     a = (char*)strstr(a,b);
    827:     if (a) ltmp = a++;
    828:   }
    829:   *tmp = (char*)ltmp;
    830:   return 0;
    831: }

    833: /*@C
    834:    PetscStrstr - Locates first occurrence of string in another string

    836:    Not Collective

    838:    Input Parameters:
    839: +  haystack - string to search
    840: -  needle - string to find

    842:    Output Parameter:
    843: .  tmp - location of occurrence, is a NULL if the string is not found

    845:    Notes:
    846:     Not for use in Fortran

    848:    Level: intermediate

    850: @*/
    851: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
    852: {
    856:   *tmp = (char*)strstr(haystack,needle);
    857:   return 0;
    858: }

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

    862: /*@C
    863:    PetscTokenFind - Locates next "token" in a string

    865:    Not Collective

    867:    Input Parameters:
    868: .  a - pointer to token

    870:    Output Parameter:
    871: .  result - location of occurrence, NULL if not found

    873:    Notes:

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

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

    881:      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
    882:    second will return a null terminated y

    884:      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

    886:     Not for use in Fortran

    888:    Level: intermediate

    890: .seealso: PetscTokenCreate(), PetscTokenDestroy()
    891: @*/
    892: PetscErrorCode PetscTokenFind(PetscToken a, char *result[])
    893: {
    894:   char *ptr,token;

    898:   *result = ptr = a->current;
    899:   if (ptr && !*ptr) {*result = NULL; return 0;}
    900:   token = a->token;
    901:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
    902:   while (ptr) {
    903:     if (*ptr == token) {
    904:       *ptr++ = 0;
    905:       while (*ptr == a->token) ptr++;
    906:       a->current = ptr;
    907:       break;
    908:     }
    909:     if (!*ptr) {
    910:       a->current = NULL;
    911:       break;
    912:     }
    913:     ptr++;
    914:   }
    915:   return 0;
    916: }

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

    921:    Not Collective

    923:    Input Parameters:
    924: +  string - the string to look in
    925: -  b - the separator character

    927:    Output Parameter:
    928: .  t- the token object

    930:    Notes:

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

    935:     Not for use in Fortran

    937:    Level: intermediate

    939: .seealso: PetscTokenFind(), PetscTokenDestroy()
    940: @*/
    941: PetscErrorCode PetscTokenCreate(const char a[], const char b, PetscToken *t)
    942: {
    945:   PetscNew(t);
    946:   PetscStrallocpy(a,&(*t)->array);

    948:   (*t)->current = (*t)->array;
    949:   (*t)->token   = b;
    950:   return 0;
    951: }

    953: /*@C
    954:    PetscTokenDestroy - Destroys a PetscToken

    956:    Not Collective

    958:    Input Parameters:
    959: .  a - pointer to token

    961:    Level: intermediate

    963:    Notes:
    964:     Not for use in Fortran

    966: .seealso: PetscTokenCreate(), PetscTokenFind()
    967: @*/
    968: PetscErrorCode PetscTokenDestroy(PetscToken *a)
    969: {
    970:   if (!*a) return 0;
    971:   PetscFree((*a)->array);
    972:   PetscFree(*a);
    973:   return 0;
    974: }

    976: /*@C
    977:    PetscStrInList - search string in character-delimited list

    979:    Not Collective

    981:    Input Parameters:
    982: +  str - the string to look for
    983: .  list - the list to search in
    984: -  sep - the separator character

    986:    Output Parameter:
    987: .  found - whether str is in list

    989:    Level: intermediate

    991:    Notes:
    992:     Not for use in Fortran

    994: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
    995: @*/
    996: PetscErrorCode PetscStrInList(const char str[], const char list[], char sep, PetscBool *found)
    997: {
    998:   PetscToken  token;
    999:   char       *item;

    1002:   *found = PETSC_FALSE;
    1003:   PetscTokenCreate(list,sep,&token);
    1004:   PetscTokenFind(token,&item);
    1005:   while (item) {
    1006:     PetscStrcmp(str,item,found);
    1007:     if (*found) break;
    1008:     PetscTokenFind(token,&item);
    1009:   }
    1010:   PetscTokenDestroy(&token);
    1011:   return 0;
    1012: }

    1014: /*@C
    1015:    PetscGetPetscDir - Gets the directory PETSc is installed in

    1017:    Not Collective

    1019:    Output Parameter:
    1020: .  dir - the directory

    1022:    Level: developer

    1024:    Notes:
    1025:     Not for use in Fortran

    1027: @*/
    1028: PetscErrorCode PetscGetPetscDir(const char *dir[])
    1029: {
    1031:   *dir = PETSC_DIR;
    1032:   return 0;
    1033: }

    1035: /*@C
    1036:    PetscStrreplace - Replaces substrings in string with other substrings

    1038:    Not Collective

    1040:    Input Parameters:
    1041: +   comm - MPI_Comm of processors that are processing the string
    1042: .   aa - the string to look in
    1043: .   b - the resulting copy of a with replaced strings (b can be the same as a)
    1044: -   len - the length of b

    1046:    Notes:
    1047:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
    1048:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
    1049:       as well as any environmental variables.

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

    1054:       Not for use in Fortran

    1056:    Level: intermediate

    1058: @*/
    1059: PetscErrorCode PetscStrreplace(MPI_Comm comm, const char aa[], char b[], size_t len)
    1060: {
    1061:   int            i = 0;
    1062:   size_t         l,l1,l2,l3;
    1063:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
    1064:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
    1065:   char           *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
    1066:   PetscBool      flag;
    1067:   static size_t  DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;

    1071:   if (aa == b) PetscStrallocpy(aa,(char**)&a);
    1072:   PetscMalloc1(len,&work);

    1074:   /* get values for replaced variables */
    1075:   PetscStrallocpy(PETSC_ARCH,&r[0]);
    1076:   PetscStrallocpy(PETSC_DIR,&r[1]);
    1077:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
    1078:   PetscMalloc1(DISPLAY_LENGTH,&r[3]);
    1079:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
    1080:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
    1081:   PetscMalloc1(USER_LENGTH,&r[6]);
    1082:   PetscMalloc1(HOST_LENGTH,&r[7]);
    1083:   PetscGetDisplay(r[3],DISPLAY_LENGTH);
    1084:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
    1085:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
    1086:   PetscGetUserName(r[6],USER_LENGTH);
    1087:   PetscGetHostName(r[7],HOST_LENGTH);

    1089:   /* replace that are in environment */
    1090:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);
    1091:   if (flag) {
    1092:     PetscFree(r[2]);
    1093:     PetscStrallocpy(env,&r[2]);
    1094:   }

    1096:   /* replace the requested strings */
    1097:   PetscStrncpy(b,a,len);
    1098:   while (s[i]) {
    1099:     PetscStrlen(s[i],&l);
    1100:     PetscStrstr(b,s[i],&par);
    1101:     while (par) {
    1102:       *par = 0;
    1103:       par += l;

    1105:       PetscStrlen(b,&l1);
    1106:       PetscStrlen(r[i],&l2);
    1107:       PetscStrlen(par,&l3);
    1109:       PetscStrncpy(work,b,len);
    1110:       PetscStrlcat(work,r[i],len);
    1111:       PetscStrlcat(work,par,len);
    1112:       PetscStrncpy(b,work,len);
    1113:       PetscStrstr(b,s[i],&par);
    1114:     }
    1115:     i++;
    1116:   }
    1117:   i = 0;
    1118:   while (r[i]) {
    1119:     tfree = (char*)r[i];
    1120:     PetscFree(tfree);
    1121:     i++;
    1122:   }

    1124:   /* look for any other ${xxx} strings to replace from environmental variables */
    1125:   PetscStrstr(b,"${",&par);
    1126:   while (par) {
    1127:     *par  = 0;
    1128:     par  += 2;
    1129:     PetscStrncpy(work,b,len);
    1130:     PetscStrstr(par,"}",&epar);
    1131:     *epar = 0;
    1132:     epar += 1;
    1133:     PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);
    1135:     PetscStrlcat(work,env,len);
    1136:     PetscStrlcat(work,epar,len);
    1137:     PetscStrncpy(b,work,len);
    1138:     PetscStrstr(b,"${",&par);
    1139:   }
    1140:   PetscFree(work);
    1141:   if (aa == b) PetscFree(a);
    1142:   return 0;
    1143: }

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

    1148:    Not Collective

    1150:    Input Parameters:
    1151: +  n - number of strings in
    1152: .  list - list of strings to search
    1153: -  str - string to look for, empty string "" accepts default (first entry in list)

    1155:    Output Parameters:
    1156: +  value - index of matching string (if found)
    1157: -  found - boolean indicating whether string was found (can be NULL)

    1159:    Notes:
    1160:    Not for use in Fortran

    1162:    Level: advanced
    1163: @*/
    1164: PetscErrorCode PetscEListFind(PetscInt n, const char *const *list, const char *str, PetscInt *value, PetscBool *found)
    1165: {
    1166:   if (found) {
    1168:     *found = PETSC_FALSE;
    1169:   }
    1170:   for (PetscInt i = 0; i < n; ++i) {
    1171:     PetscBool matched;

    1173:     PetscStrcasecmp(str,list[i],&matched);
    1174:     if (matched || !str[0]) {
    1175:       if (found) *found = PETSC_TRUE;
    1176:       *value = i;
    1177:       break;
    1178:     }
    1179:   }
    1180:   return 0;
    1181: }

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

    1186:    Not Collective

    1188:    Input Parameters:
    1189: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
    1190: -  str - string to look for

    1192:    Output Parameters:
    1193: +  value - index of matching string (if found)
    1194: -  found - boolean indicating whether string was found (can be NULL)

    1196:    Notes:
    1197:    Not for use in Fortran

    1199:    Level: advanced
    1200: @*/
    1201: PetscErrorCode PetscEnumFind(const char *const *enumlist, const char *str, PetscEnum *value, PetscBool *found)
    1202: {
    1203:   PetscInt  n = 0,evalue;
    1204:   PetscBool efound;

    1209:   n -= 3; /* drop enum name, prefix, and null termination */
    1210:   PetscEListFind(n,enumlist,str,&evalue,&efound);
    1211:   if (efound) {
    1213:     *value = (PetscEnum)evalue;
    1214:   }
    1215:   if (found) {
    1217:     *found = efound;
    1218:   }
    1219:   return 0;
    1220: }