Actual source code: str.c

petsc-master 2017-11-21
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: this may be called before PetscInitialize() or after PetscFinalize()

 33:    Not for use in Fortran

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

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

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

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

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

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

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

 99: /*@C
100:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

102:    Not Collective

104:    Output Parameters:
105: +  argc - the number of arguments
106: -  args - the array of arguments

108:    Level: intermediate

110:    Concepts: command line arguments

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

114:    Not for use in Fortran

116: .seealso: PetscStrToArray()

118: @*/
119: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
120: {
121:   PetscInt i;

123:   for (i=0; i<argc; i++) free(args[i]);
124:   if (args) free(args);
125:   return 0;
126: }

128: /*@C
129:    PetscStrlen - Gets length of a string

131:    Not Collective

133:    Input Parameters:
134: .  s - pointer to string

136:    Output Parameter:
137: .  len - length in bytes

139:    Level: intermediate

141:    Note:
142:    This routine is analogous to strlen().

144:    Null string returns a length of zero

146:    Not for use in Fortran

148:   Concepts: string length

150: @*/
151: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
152: {
154:   if (!s) *len = 0;
155:   else    *len = strlen(s);
156:   return(0);
157: }

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

162:    Not Collective

164:    Input Parameters:
165: .  s - pointer to string

167:    Output Parameter:
168: .  t - the copied string

170:    Level: intermediate

172:    Note:
173:       Null string returns a new null string

175:       Not for use in Fortran

177:   Concepts: string copy

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

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

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

199:    Not Collective

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

204:    Output Parameter:
205: .  t - the copied array string

207:    Level: intermediate

209:    Note:
210:       Not for use in Fortran

212:   Concepts: string copy

214: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

216: @*/
217: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
218: {
220:   PetscInt       i,n = 0;

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

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

235:    Not Collective

237:    Output Parameters:
238: .   list - array of strings

240:    Level: intermediate

242:    Concepts: command line arguments

244:    Notes: Not for use in Fortran

246: .seealso: PetscStrArrayallocpy()

248: @*/
249: PetscErrorCode PetscStrArrayDestroy(char ***list)
250: {
251:   PetscInt       n = 0;

255:   if (!*list) return(0);
256:   while ((*list)[n]) {
257:     PetscFree((*list)[n]);
258:     n++;
259:   }
260:   PetscFree(*list);
261:   return(0);
262: }

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

267:    Not Collective

269:    Input Parameters:
270: +  n - the number of string entries
271: -  s - pointer to array of strings

273:    Output Parameter:
274: .  t - the copied array string

276:    Level: intermediate

278:    Note:
279:       Not for use in Fortran

281:   Concepts: string copy

283: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

285: @*/
286: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
287: {
289:   PetscInt       i;

292:   PetscMalloc1(n,t);
293:   for (i=0; i<n; i++) {
294:     PetscStrallocpy(list[i],(*t)+i);
295:   }
296:   return(0);
297: }

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

302:    Not Collective

304:    Output Parameters:
305: +   n - number of string entries
306: -   list - array of strings

308:    Level: intermediate

310:    Notes: Not for use in Fortran

312: .seealso: PetscStrArrayallocpy()

314: @*/
315: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
316: {
318:   PetscInt       i;

321:   if (!*list) return(0);
322:   for (i=0; i<n; i++){
323:     PetscFree((*list)[i]);
324:   }
325:   PetscFree(*list);
326:   return(0);
327: }

329: /*@C
330:    PetscStrcpy - Copies a string

332:    Not Collective

334:    Input Parameters:
335: .  t - pointer to string

337:    Output Parameter:
338: .  s - the copied string

340:    Level: intermediate

342:    Notes:
343:      Null string returns a string starting with zero

345:      Not for use in Fortran

347:   Concepts: string copy

349: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()

351: @*/

353: PetscErrorCode  PetscStrcpy(char s[],const char t[])
354: {
356:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
357:   if (t) strcpy(s,t);
358:   else if (s) s[0] = 0;
359:   return(0);
360: }

362: /*@C
363:    PetscStrncpy - Copies a string up to a certain length

365:    Not Collective

367:    Input Parameters:
368: +  t - pointer to string
369: -  n - the length to copy

371:    Output Parameter:
372: .  s - the copied string

374:    Level: intermediate

376:    Note:
377:      Null string returns a string starting with zero

379:      If the string that is being copied is of length n or larger then the entire string is not
380:      copied and the file location of s is set to NULL. This is different then the behavior of 
381:      strncpy() which leaves s non-terminated.

383:   Concepts: string copy

385: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()

387: @*/
388: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
389: {
391:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
392:   if (t) {
393:     if (n > 1) {
394:       strncpy(s,t,n-1);
395:       s[n-1] = '\0';
396:     } else {
397:       s[0] = '\0';
398:     }
399:   } else if (s) s[0] = 0;
400:   return(0);
401: }

403: /*@C
404:    PetscStrcat - Concatenates a string onto a given string

406:    Not Collective

408:    Input Parameters:
409: +  s - string to be added to
410: -  t - pointer to string to be added to end

412:    Level: intermediate

414:    Notes: Not for use in Fortran

416:   Concepts: string copy

418: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()

420: @*/
421: PetscErrorCode  PetscStrcat(char s[],const char t[])
422: {
424:   if (!t) return(0);
425:   strcat(s,t);
426:   return(0);
427: }

429: /*@C
430:    PetscStrncat - Concatenates a string onto a given string, up to a given length

432:    Not Collective

434:    Input Parameters:
435: +  s - pointer to string to be added to end
436: .  t - string to be added to
437: .  n - maximum length to copy

439:    Level: intermediate

441:   Notes:    Not for use in Fortran

443:   Concepts: string copy

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

447: @*/
448: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
449: {
451:   strncat(s,t,n);
452:   return(0);
453: }

455: /*

458: */
459: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
460: {
461:   int c;

463:   if (!a && !b)      *flg = PETSC_TRUE;
464:   else if (!a || !b) *flg = PETSC_FALSE;
465:   else {
466:     c = strcmp(a,b);
467:     if (c) *flg = PETSC_FALSE;
468:     else   *flg = PETSC_TRUE;
469:   }
470: }

472: /*@C
473:    PetscStrcmp - Compares two strings,

475:    Not Collective

477:    Input Parameters:
478: +  a - pointer to string first string
479: -  b - pointer to second string

481:    Output Parameter:
482: .  flg - PETSC_TRUE if the two strings are equal

484:    Level: intermediate

486:    Notes:    Not for use in Fortran

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

490: @*/
491: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
492: {
493:   int c;

496:   if (!a && !b)      *flg = PETSC_TRUE;
497:   else if (!a || !b) *flg = PETSC_FALSE;
498:   else {
499:     c = strcmp(a,b);
500:     if (c) *flg = PETSC_FALSE;
501:     else   *flg = PETSC_TRUE;
502:   }
503:   return(0);
504: }

506: /*@C
507:    PetscStrgrt - If first string is greater than the second

509:    Not Collective

511:    Input Parameters:
512: +  a - pointer to first string
513: -  b - pointer to second string

515:    Output Parameter:
516: .  flg - if the first string is greater

518:    Notes:
519:     Null arguments are ok, a null string is considered smaller than
520:     all others

522:    Not for use in Fortran

524:    Level: intermediate

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

528: @*/
529: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
530: {
531:   int c;

534:   if (!a && !b) *t = PETSC_FALSE;
535:   else if (a && !b) *t = PETSC_TRUE;
536:   else if (!a && b) *t = PETSC_FALSE;
537:   else {
538:     c = strcmp(a,b);
539:     if (c > 0) *t = PETSC_TRUE;
540:     else       *t = PETSC_FALSE;
541:   }
542:   return(0);
543: }

545: /*@C
546:    PetscStrcasecmp - Returns true if the two strings are the same
547:      except possibly for case.

549:    Not Collective

551:    Input Parameters:
552: +  a - pointer to first string
553: -  b - pointer to second string

555:    Output Parameter:
556: .  flg - if the two strings are the same

558:    Notes:
559:     Null arguments are ok

561:    Not for use in Fortran

563:    Level: intermediate

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

567: @*/
568: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
569: {
570:   int c;

573:   if (!a && !b) c = 0;
574:   else if (!a || !b) c = 1;
575: #if defined(PETSC_HAVE_STRCASECMP)
576:   else c = strcasecmp(a,b);
577: #elif defined(PETSC_HAVE_STRICMP)
578:   else c = stricmp(a,b);
579: #else
580:   else {
581:     char           *aa,*bb;
583:     PetscStrallocpy(a,&aa);
584:     PetscStrallocpy(b,&bb);
585:     PetscStrtolower(aa);
586:     PetscStrtolower(bb);
587:     PetscStrcmp(aa,bb,t);
588:     PetscFree(aa);
589:     PetscFree(bb);
590:     return(0);
591:   }
592: #endif
593:   if (!c) *t = PETSC_TRUE;
594:   else    *t = PETSC_FALSE;
595:   return(0);
596: }



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

603:    Not Collective

605:    Input Parameters:
606: +  a - pointer to first string
607: .  b - pointer to second string
608: -  n - length to compare up to

610:    Output Parameter:
611: .  t - if the two strings are equal

613:    Level: intermediate

615:    Notes:    Not for use in Fortran

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

619: @*/
620: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
621: {
622:   int c;

625:   c = strncmp(a,b,n);
626:   if (!c) *t = PETSC_TRUE;
627:   else    *t = PETSC_FALSE;
628:   return(0);
629: }

631: /*@C
632:    PetscStrchr - Locates first occurance of a character in a string

634:    Not Collective

636:    Input Parameters:
637: +  a - pointer to string
638: -  b - character

640:    Output Parameter:
641: .  c - location of occurance, NULL if not found

643:    Level: intermediate

645:    Notes:    Not for use in Fortran

647: @*/
648: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
649: {
651:   *c = (char*)strchr(a,b);
652:   return(0);
653: }

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

659:    Not Collective

661:    Input Parameters:
662: +  a - pointer to string
663: -  b - character

665:    Output Parameter:
666: .  tmp - location of occurance, a if not found

668:    Level: intermediate

670:    Notes:    Not for use in Fortran

672: @*/
673: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
674: {
676:   *tmp = (char*)strrchr(a,b);
677:   if (!*tmp) *tmp = (char*)a;
678:   else *tmp = *tmp + 1;
679:   return(0);
680: }

682: /*@C
683:    PetscStrtolower - Converts string to lower case

685:    Not Collective

687:    Input Parameters:
688: .  a - pointer to string

690:    Level: intermediate

692:    Notes:    Not for use in Fortran

694: @*/
695: PetscErrorCode  PetscStrtolower(char a[])
696: {
698:   while (*a) {
699:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
700:     a++;
701:   }
702:   return(0);
703: }

705: /*@C
706:    PetscStrtoupper - Converts string to upper case

708:    Not Collective

710:    Input Parameters:
711: .  a - pointer to string

713:    Level: intermediate

715:    Notes:    Not for use in Fortran

717: @*/
718: PetscErrorCode  PetscStrtoupper(char a[])
719: {
721:   while (*a) {
722:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
723:     a++;
724:   }
725:   return(0);
726: }

728: /*@C
729:    PetscStrendswith - Determines if a string ends with a certain string

731:    Not Collective

733:    Input Parameters:
734: +  a - pointer to string
735: -  b - string to endwith

737:    Output Parameter:
738: .  flg - PETSC_TRUE or PETSC_FALSE

740:    Notes:     Not for use in Fortran

742:    Level: intermediate

744: @*/
745: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
746: {
747:   char           *test;
749:   size_t         na,nb;

752:   *flg = PETSC_FALSE;
753:   PetscStrrstr(a,b,&test);
754:   if (test) {
755:     PetscStrlen(a,&na);
756:     PetscStrlen(b,&nb);
757:     if (a+na-nb == test) *flg = PETSC_TRUE;
758:   }
759:   return(0);
760: }

762: /*@C
763:    PetscStrbeginswith - Determines if a string begins with a certain string

765:    Not Collective

767:    Input Parameters:
768: +  a - pointer to string
769: -  b - string to begin with

771:    Output Parameter:
772: .  flg - PETSC_TRUE or PETSC_FALSE

774:    Notes:     Not for use in Fortran

776:    Level: intermediate

778: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
779:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

781: @*/
782: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
783: {
784:   char           *test;

788:   *flg = PETSC_FALSE;
789:   PetscStrrstr(a,b,&test);
790:   if (test && (test == a)) *flg = PETSC_TRUE;
791:   return(0);
792: }


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

798:    Not Collective

800:    Input Parameters:
801: +  a - pointer to string
802: -  bs - strings to endwith (last entry must be null)

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

807:    Notes:     Not for use in Fortran

809:    Level: intermediate

811: @*/
812: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
813: {
814:   PetscBool      flg;

818:   *cnt = 0;
819:   while (bs[*cnt]) {
820:     PetscStrendswith(a,bs[*cnt],&flg);
821:     if (flg) return(0);
822:     *cnt += 1;
823:   }
824:   return(0);
825: }

827: /*@C
828:    PetscStrrstr - Locates last occurance of string in another string

830:    Not Collective

832:    Input Parameters:
833: +  a - pointer to string
834: -  b - string to find

836:    Output Parameter:
837: .  tmp - location of occurance

839:    Notes:     Not for use in Fortran

841:    Level: intermediate

843: @*/
844: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
845: {
846:   const char *stmp = a, *ltmp = 0;

849:   while (stmp) {
850:     stmp = (char*)strstr(stmp,b);
851:     if (stmp) {ltmp = stmp;stmp++;}
852:   }
853:   *tmp = (char*)ltmp;
854:   return(0);
855: }

857: /*@C
858:    PetscStrstr - Locates first occurance of string in another string

860:    Not Collective

862:    Input Parameters:
863: +  haystack - string to search
864: -  needle - string to find

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

869:    Notes: Not for use in Fortran

871:    Level: intermediate

873: @*/
874: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
875: {
877:   *tmp = (char*)strstr(haystack,needle);
878:   return(0);
879: }

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

883: /*@C
884:    PetscTokenFind - Locates next "token" in a string

886:    Not Collective

888:    Input Parameters:
889: .  a - pointer to token

891:    Output Parameter:
892: .  result - location of occurance, NULL if not found

894:    Notes:

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

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

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

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

907:     Not for use in Fortran

909:    Level: intermediate


912: .seealso: PetscTokenCreate(), PetscTokenDestroy()
913: @*/
914: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
915: {
916:   char *ptr = a->current,token;

919:   *result = a->current;
920:   if (ptr && !*ptr) {*result = 0;return(0);}
921:   token = a->token;
922:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
923:   while (ptr) {
924:     if (*ptr == token) {
925:       *ptr++ = 0;
926:       while (*ptr == a->token) ptr++;
927:       a->current = ptr;
928:       break;
929:     }
930:     if (!*ptr) {
931:       a->current = 0;
932:       break;
933:     }
934:     ptr++;
935:   }
936:   return(0);
937: }

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

942:    Not Collective

944:    Input Parameters:
945: +  string - the string to look in
946: -  b - the separator character

948:    Output Parameter:
949: .  t- the token object

951:    Notes:

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

956:     Not for use in Fortran

958:    Level: intermediate

960: .seealso: PetscTokenFind(), PetscTokenDestroy()
961: @*/
962: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
963: {

967:   PetscNew(t);
968:   PetscStrallocpy(a,&(*t)->array);

970:   (*t)->current = (*t)->array;
971:   (*t)->token   = b;
972:   return(0);
973: }

975: /*@C
976:    PetscTokenDestroy - Destroys a PetscToken

978:    Not Collective

980:    Input Parameters:
981: .  a - pointer to token

983:    Level: intermediate

985:    Notes:     Not for use in Fortran

987: .seealso: PetscTokenCreate(), PetscTokenFind()
988: @*/
989: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
990: {

994:   if (!*a) return(0);
995:   PetscFree((*a)->array);
996:   PetscFree(*a);
997:   return(0);
998: }


1001: /*@C
1002:    PetscGetPetscDir - Gets the directory PETSc is installed in

1004:    Not Collective

1006:    Output Parameter:
1007: .  dir - the directory

1009:    Level: developer

1011:    Notes: Not for use in Fortran

1013: @*/
1014: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1015: {
1017:   *dir = PETSC_DIR;
1018:   return(0);
1019: }

1021: /*@C
1022:    PetscStrreplace - Replaces substrings in string with other substrings

1024:    Not Collective

1026:    Input Parameters:
1027: +   comm - MPI_Comm of processors that are processing the string
1028: .   aa - the string to look in
1029: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1030: -   len - the length of b

1032:    Notes:
1033:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1034:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1035:       as well as any environmental variables.

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

1040:       Not for use in Fortran

1042:    Level: intermediate

1044: @*/
1045: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1046: {
1048:   int            i = 0;
1049:   size_t         l,l1,l2,l3;
1050:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1051:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1052:   char           *r[] = {0,0,0,0,0,0,0,0,0};
1053:   PetscBool      flag;

1056:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1057:   if (aa == b) {
1058:     PetscStrallocpy(aa,(char**)&a);
1059:   }
1060:   PetscMalloc1(len,&work);

1062:   /* get values for replaced variables */
1063:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1064:   PetscStrallocpy(PETSC_DIR,&r[1]);
1065:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1066:   PetscMalloc1(256,&r[3]);
1067:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1068:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1069:   PetscMalloc1(256,&r[6]);
1070:   PetscMalloc1(256,&r[7]);
1071:   PetscGetDisplay(r[3],256);
1072:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1073:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1074:   PetscGetUserName(r[6],256);
1075:   PetscGetHostName(r[7],256);

1077:   /* replace that are in environment */
1078:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1079:   if (flag) {
1080:     PetscFree(r[2]);
1081:     PetscStrallocpy(env,&r[2]);
1082:   }

1084:   /* replace the requested strings */
1085:   PetscStrncpy(b,a,len);
1086:   while (s[i]) {
1087:     PetscStrlen(s[i],&l);
1088:     PetscStrstr(b,s[i],&par);
1089:     while (par) {
1090:       *par =  0;
1091:       par += l;

1093:       PetscStrlen(b,&l1);
1094:       PetscStrlen(r[i],&l2);
1095:       PetscStrlen(par,&l3);
1096:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1097:       PetscStrcpy(work,b);
1098:       PetscStrcat(work,r[i]);
1099:       PetscStrcat(work,par);
1100:       PetscStrncpy(b,work,len);
1101:       PetscStrstr(b,s[i],&par);
1102:     }
1103:     i++;
1104:   }
1105:   i = 0;
1106:   while (r[i]) {
1107:     tfree = (char*)r[i];
1108:     PetscFree(tfree);
1109:     i++;
1110:   }

1112:   /* look for any other ${xxx} strings to replace from environmental variables */
1113:   PetscStrstr(b,"${",&par);
1114:   while (par) {
1115:     *par  = 0;
1116:     par  += 2;
1117:     PetscStrcpy(work,b);
1118:     PetscStrstr(par,"}",&epar);
1119:     *epar = 0;
1120:     epar += 1;
1121:     PetscOptionsGetenv(comm,par,env,256,&flag);
1122:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1123:     PetscStrcat(work,env);
1124:     PetscStrcat(work,epar);
1125:     PetscStrcpy(b,work);
1126:     PetscStrstr(b,"${",&par);
1127:   }
1128:   PetscFree(work);
1129:   if (aa == b) {
1130:     PetscFree(a);
1131:   }
1132:   return(0);
1133: }

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

1138:    Not Collective

1140:    Input Parameters:
1141: +  n - number of strings in
1142: .  list - list of strings to search
1143: -  str - string to look for, empty string "" accepts default (first entry in list)

1145:    Output Parameters:
1146: +  value - index of matching string (if found)
1147: -  found - boolean indicating whether string was found (can be NULL)

1149:    Notes:
1150:    Not for use in Fortran

1152:    Level: advanced
1153: @*/
1154: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1155: {
1157:   PetscBool matched;
1158:   PetscInt i;

1161:   if (found) *found = PETSC_FALSE;
1162:   for (i=0; i<n; i++) {
1163:     PetscStrcasecmp(str,list[i],&matched);
1164:     if (matched || !str[0]) {
1165:       if (found) *found = PETSC_TRUE;
1166:       *value = i;
1167:       break;
1168:     }
1169:   }
1170:   return(0);
1171: }

1173: /*@C
1174:    PetscEListFind - searches enum list of strings for given string, using case insensitive matching

1176:    Not Collective

1178:    Input Parameters:
1179: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1180: -  str - string to look for

1182:    Output Parameters:
1183: +  value - index of matching string (if found)
1184: -  found - boolean indicating whether string was found (can be NULL)

1186:    Notes:
1187:    Not for use in Fortran

1189:    Level: advanced
1190: @*/
1191: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1192: {
1194:   PetscInt n = 0,evalue;
1195:   PetscBool efound;

1198:   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");
1199:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1200:   n -= 3; /* drop enum name, prefix, and null termination */
1201:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1202:   if (efound) *value = (PetscEnum)evalue;
1203:   if (found) *found = efound;
1204:   return(0);
1205: }