Actual source code: str.c

petsc-3.6.1 2015-08-06
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>                   /*I  "petscsys.h"   I*/
  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

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

 21:    Not Collective

 23:    Input Parameters:
 24: +  s - pointer to string
 25: -  sp - separator charactor

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

 31:    Level: intermediate

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

 35:    Not for use in Fortran

 37:    Developer Notes: 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,n,*lens,cnt = 0;
 46:   PetscBool flg = PETSC_FALSE;

 48:   if (!s) n = 0;
 49:   else    n = strlen(s);
 50:   *argc = 0;
 51:   if (!n) {
 52:     *args = 0;
 53:     return(0);
 54:   }
 55:   for (i=0; i<n; i++) {
 56:     if (s[i] != sp) break;
 57:   }
 58:   for (;i<n+1; i++) {
 59:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 60:     else if (s[i] != sp) {flg = PETSC_FALSE;}
 61:   }
 62:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 63:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 64:   for (i=0; i<*argc; i++) lens[i] = 0;

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

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

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

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

 97:    Not Collective

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

103:    Level: intermediate

105:    Concepts: command line arguments

107:    Notes: 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:   PetscInt i;

118:   for (i=0; i<argc; i++) free(args[i]);
119:   if (args) free(args);
120:   return 0;
121: }

125: /*@C
126:    PetscStrlen - Gets length of a string

128:    Not Collective

130:    Input Parameters:
131: .  s - pointer to string

133:    Output Parameter:
134: .  len - length in bytes

136:    Level: intermediate

138:    Note:
139:    This routine is analogous to strlen().

141:    Null string returns a length of zero

143:    Not for use in Fortran

145:   Concepts: string length

147: @*/
148: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
149: {
151:   if (!s) *len = 0;
152:   else    *len = strlen(s);
153:   return(0);
154: }

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

161:    Not Collective

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

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

169:    Level: intermediate

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

174:       Not for use in Fortran

176:   Concepts: string copy

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

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

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

200:    Not Collective

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

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

208:    Level: intermediate

210:    Note:
211:       Not for use in Fortran

213:   Concepts: string copy

215: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

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

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

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: Not for use in Fortran

249: .seealso: PetscStrArrayallocpy()

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

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

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

272:    Not Collective

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

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

281:    Level: intermediate

283:    Note:
284:       Not for use in Fortran

286:   Concepts: string copy

288: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

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

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

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

309:    Not Collective

311:    Output Parameters:
312: +   n - number of string entries
313: -   list - array of strings

315:    Level: intermediate

317:    Notes: Not for use in Fortran

319: .seealso: PetscStrArrayallocpy()

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

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

338: /*@C
339:    PetscStrcpy - Copies a string

341:    Not Collective

343:    Input Parameters:
344: .  t - pointer to string

346:    Output Parameter:
347: .  s - the copied string

349:    Level: intermediate

351:    Notes:
352:      Null string returns a string starting with zero

354:      Not for use in Fortran

356:   Concepts: string copy

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

360: @*/

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

373: /*@C
374:    PetscStrncpy - Copies a string up to a certain length

376:    Not Collective

378:    Input Parameters:
379: +  t - pointer to string
380: -  n - the length to copy

382:    Output Parameter:
383: .  s - the copied string

385:    Level: intermediate

387:    Note:
388:      Null string returns a string starting with zero

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

394:   Concepts: string copy

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

398: @*/
399: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
400: {
402:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
403:   if (t) {
404:     if (n > 1) {
405:       strncpy(s,t,n-1);
406:       s[n-1] = '\0';
407:     } else {
408:       s[0] = '\0';
409:     }
410:   } else if (s) s[0] = 0;
411:   return(0);
412: }

416: /*@C
417:    PetscStrcat - Concatenates a string onto a given string

419:    Not Collective

421:    Input Parameters:
422: +  s - string to be added to
423: -  t - pointer to string to be added to end

425:    Level: intermediate

427:    Notes: Not for use in Fortran

429:   Concepts: string copy

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

433: @*/
434: PetscErrorCode  PetscStrcat(char s[],const char t[])
435: {
437:   if (!t) return(0);
438:   strcat(s,t);
439:   return(0);
440: }

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

447:    Not Collective

449:    Input Parameters:
450: +  s - pointer to string to be added to end
451: .  t - string to be added to
452: .  n - maximum length to copy

454:    Level: intermediate

456:   Notes:    Not for use in Fortran

458:   Concepts: string copy

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

462: @*/
463: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
464: {
466:   strncat(s,t,n);
467:   return(0);
468: }

472: /*

475:    Will be removed once we eliminate the __FUNCT__ paradigm
476: */
477: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
478: {
479:   int c;

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

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

495:    Not Collective

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

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

504:    Level: intermediate

506:    Notes:    Not for use in Fortran

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

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

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

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

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

573:    Not Collective

575:    Input Parameters:
576: +  a - pointer to first string
577: -  b - pointer to second string

579:    Output Parameter:
580: .  flg - if the two strings are the same

582:    Notes:
583:     Null arguments are ok

585:    Not for use in Fortran

587:    Level: intermediate

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

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

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



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

629:    Not Collective

631:    Input Parameters:
632: +  a - pointer to first string
633: .  b - pointer to second string
634: -  n - length to compare up to

636:    Output Parameter:
637: .  t - if the two strings are equal

639:    Level: intermediate

641:    Notes:    Not for use in Fortran

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

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

651:   c = strncmp(a,b,n);
652:   if (!c) *t = PETSC_TRUE;
653:   else    *t = PETSC_FALSE;
654:   return(0);
655: }

659: /*@C
660:    PetscStrchr - Locates first occurance of a character in a string

662:    Not Collective

664:    Input Parameters:
665: +  a - pointer to string
666: -  b - character

668:    Output Parameter:
669: .  c - location of occurance, NULL if not found

671:    Level: intermediate

673:    Notes:    Not for use in Fortran

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

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

689:    Not Collective

691:    Input Parameters:
692: +  a - pointer to string
693: -  b - character

695:    Output Parameter:
696: .  tmp - location of occurance, a if not found

698:    Level: intermediate

700:    Notes:    Not for use in Fortran

702: @*/
703: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
704: {
706:   *tmp = (char*)strrchr(a,b);
707:   if (!*tmp) *tmp = (char*)a;
708:   else *tmp = *tmp + 1;
709:   return(0);
710: }

714: /*@C
715:    PetscStrtolower - Converts string to lower case

717:    Not Collective

719:    Input Parameters:
720: .  a - pointer to string

722:    Level: intermediate

724:    Notes:    Not for use in Fortran

726: @*/
727: PetscErrorCode  PetscStrtolower(char a[])
728: {
730:   while (*a) {
731:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
732:     a++;
733:   }
734:   return(0);
735: }

739: /*@C
740:    PetscStrtolower - Converts string to upper case

742:    Not Collective

744:    Input Parameters:
745: .  a - pointer to string

747:    Level: intermediate

749:    Notes:    Not for use in Fortran

751: @*/
752: PetscErrorCode  PetscStrtoupper(char a[])
753: {
755:   while (*a) {
756:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
757:     a++;
758:   }
759:   return(0);
760: }

764: /*@C
765:    PetscStrendswith - Determines if a string ends with a certain string

767:    Not Collective

769:    Input Parameters:
770: +  a - pointer to string
771: -  b - string to endwith

773:    Output Parameter:
774: .  flg - PETSC_TRUE or PETSC_FALSE

776:    Notes:     Not for use in Fortran

778:    Level: intermediate

780: @*/
781: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
782: {
783:   char           *test;
785:   size_t         na,nb;

788:   *flg = PETSC_FALSE;
789:   PetscStrrstr(a,b,&test);
790:   if (test) {
791:     PetscStrlen(a,&na);
792:     PetscStrlen(b,&nb);
793:     if (a+na-nb == test) *flg = PETSC_TRUE;
794:   }
795:   return(0);
796: }

800: /*@C
801:    PetscStrbeginswith - Determines if a string begins with a certain string

803:    Not Collective

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

809:    Output Parameter:
810: .  flg - PETSC_TRUE or PETSC_FALSE

812:    Notes:     Not for use in Fortran

814:    Level: intermediate

816: @*/
817: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
818: {
819:   char           *test;

823:   *flg = PETSC_FALSE;
824:   PetscStrrstr(a,b,&test);
825:   if (test && (test == a)) *flg = PETSC_TRUE;
826:   return(0);
827: }


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

835:    Not Collective

837:    Input Parameters:
838: +  a - pointer to string
839: -  bs - strings to endwith (last entry must be null)

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

844:    Notes:     Not for use in Fortran

846:    Level: intermediate

848: @*/
849: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
850: {
851:   PetscBool      flg;

855:   *cnt = 0;
856:   while (bs[*cnt]) {
857:     PetscStrendswith(a,bs[*cnt],&flg);
858:     if (flg) return(0);
859:     *cnt += 1;
860:   }
861:   return(0);
862: }

866: /*@C
867:    PetscStrrstr - Locates last occurance of string in another string

869:    Not Collective

871:    Input Parameters:
872: +  a - pointer to string
873: -  b - string to find

875:    Output Parameter:
876: .  tmp - location of occurance

878:    Notes:     Not for use in Fortran

880:    Level: intermediate

882: @*/
883: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
884: {
885:   const char *stmp = a, *ltmp = 0;

888:   while (stmp) {
889:     stmp = (char*)strstr(stmp,b);
890:     if (stmp) {ltmp = stmp;stmp++;}
891:   }
892:   *tmp = (char*)ltmp;
893:   return(0);
894: }

898: /*@C
899:    PetscStrstr - Locates first occurance of string in another string

901:    Not Collective

903:    Input Parameters:
904: +  haystack - string to search
905: -  needle - string to find

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

910:    Notes: Not for use in Fortran

912:    Level: intermediate

914: @*/
915: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
916: {
918:   *tmp = (char*)strstr(haystack,needle);
919:   return(0);
920: }

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

926: /*@C
927:    PetscTokenFind - Locates next "token" in a string

929:    Not Collective

931:    Input Parameters:
932: .  a - pointer to token

934:    Output Parameter:
935: .  result - location of occurance, NULL if not found

937:    Notes:

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

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

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

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

950:     Not for use in Fortran

952:    Level: intermediate


955: .seealso: PetscTokenCreate(), PetscTokenDestroy()
956: @*/
957: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
958: {
959:   char *ptr = a->current,token;

962:   *result = a->current;
963:   if (ptr && !*ptr) {*result = 0;return(0);}
964:   token = a->token;
965:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
966:   while (ptr) {
967:     if (*ptr == token) {
968:       *ptr++ = 0;
969:       while (*ptr == a->token) ptr++;
970:       a->current = ptr;
971:       break;
972:     }
973:     if (!*ptr) {
974:       a->current = 0;
975:       break;
976:     }
977:     ptr++;
978:   }
979:   return(0);
980: }

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

987:    Not Collective

989:    Input Parameters:
990: +  string - the string to look in
991: -  b - the separator character

993:    Output Parameter:
994: .  t- the token object

996:    Notes:

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

1001:     Not for use in Fortran

1003:    Level: intermediate

1005: .seealso: PetscTokenFind(), PetscTokenDestroy()
1006: @*/
1007: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
1008: {

1012:   PetscNew(t);
1013:   PetscStrallocpy(a,&(*t)->array);

1015:   (*t)->current = (*t)->array;
1016:   (*t)->token   = b;
1017:   return(0);
1018: }

1022: /*@C
1023:    PetscTokenDestroy - Destroys a PetscToken

1025:    Not Collective

1027:    Input Parameters:
1028: .  a - pointer to token

1030:    Level: intermediate

1032:    Notes:     Not for use in Fortran

1034: .seealso: PetscTokenCreate(), PetscTokenFind()
1035: @*/
1036: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1037: {

1041:   if (!*a) return(0);
1042:   PetscFree((*a)->array);
1043:   PetscFree(*a);
1044:   return(0);
1045: }


1050: /*@C
1051:    PetscGetPetscDir - Gets the directory PETSc is installed in

1053:    Not Collective

1055:    Output Parameter:
1056: .  dir - the directory

1058:    Level: developer

1060:    Notes: Not for use in Fortran

1062: @*/
1063: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1064: {
1066:   *dir = PETSC_DIR;
1067:   return(0);
1068: }

1072: /*@C
1073:    PetscStrreplace - Replaces substrings in string with other substrings

1075:    Not Collective

1077:    Input Parameters:
1078: +   comm - MPI_Comm of processors that are processing the string
1079: .   aa - the string to look in
1080: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1081: -   len - the length of b

1083:    Notes:
1084:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1085:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1086:       as well as any environmental variables.

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

1091:       Not for use in Fortran

1093:    Level: intermediate

1095: @*/
1096: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1097: {
1099:   int            i = 0;
1100:   size_t         l,l1,l2,l3;
1101:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1102:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1103:   const char     *r[] = {0,0,0,0,0,0,0,0,0};
1104:   PetscBool      flag;

1107:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1108:   if (aa == b) {
1109:     PetscStrallocpy(aa,(char**)&a);
1110:   }
1111:   PetscMalloc1(len,&work);

1113:   /* get values for replaced variables */
1114:   PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1115:   PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1116:   PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1117:   PetscMalloc1(256,&r[3]);
1118:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1119:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1120:   PetscMalloc1(256,&r[6]);
1121:   PetscMalloc1(256,&r[7]);
1122:   PetscGetDisplay((char*)r[3],256);
1123:   PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1124:   PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1125:   PetscGetUserName((char*)r[6],256);
1126:   PetscGetHostName((char*)r[7],256);

1128:   /* replace that are in environment */
1129:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1130:   if (flag) {
1131:     PetscFree(r[2]);
1132:     PetscStrallocpy(env,(char**)&r[2]);
1133:   }

1135:   /* replace the requested strings */
1136:   PetscStrncpy(b,a,len);
1137:   while (s[i]) {
1138:     PetscStrlen(s[i],&l);
1139:     PetscStrstr(b,s[i],&par);
1140:     while (par) {
1141:       *par =  0;
1142:       par += l;

1144:       PetscStrlen(b,&l1);
1145:       PetscStrlen(r[i],&l2);
1146:       PetscStrlen(par,&l3);
1147:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1148:       PetscStrcpy(work,b);
1149:       PetscStrcat(work,r[i]);
1150:       PetscStrcat(work,par);
1151:       PetscStrncpy(b,work,len);
1152:       PetscStrstr(b,s[i],&par);
1153:     }
1154:     i++;
1155:   }
1156:   i = 0;
1157:   while (r[i]) {
1158:     tfree = (char*)r[i];
1159:     PetscFree(tfree);
1160:     i++;
1161:   }

1163:   /* look for any other ${xxx} strings to replace from environmental variables */
1164:   PetscStrstr(b,"${",&par);
1165:   while (par) {
1166:     *par  = 0;
1167:     par  += 2;
1168:     PetscStrcpy(work,b);
1169:     PetscStrstr(par,"}",&epar);
1170:     *epar = 0;
1171:     epar += 1;
1172:     PetscOptionsGetenv(comm,par,env,256,&flag);
1173:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1174:     PetscStrcat(work,env);
1175:     PetscStrcat(work,epar);
1176:     PetscStrcpy(b,work);
1177:     PetscStrstr(b,"${",&par);
1178:   }
1179:   PetscFree(work);
1180:   if (aa == b) {
1181:     PetscFree(a);
1182:   }
1183:   return(0);
1184: }

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

1191:    Not Collective

1193:    Input Parameters:
1194: +  n - number of strings in
1195: .  list - list of strings to search
1196: -  str - string to look for, empty string "" accepts default (first entry in list)

1198:    Output Parameters:
1199: +  value - index of matching string (if found)
1200: -  found - boolean indicating whether string was found (can be NULL)

1202:    Notes:
1203:    Not for use in Fortran

1205:    Level: advanced
1206: @*/
1207: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1208: {
1210:   PetscBool matched;
1211:   PetscInt i;

1214:   if (found) *found = PETSC_FALSE;
1215:   for (i=0; i<n; i++) {
1216:     PetscStrcasecmp(str,list[i],&matched);
1217:     if (matched || !str[0]) {
1218:       if (found) *found = PETSC_TRUE;
1219:       *value = i;
1220:       break;
1221:     }
1222:   }
1223:   return(0);
1224: }

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

1231:    Not Collective

1233:    Input Parameters:
1234: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1235: -  str - string to look for

1237:    Output Parameters:
1238: +  value - index of matching string (if found)
1239: -  found - boolean indicating whether string was found (can be NULL)

1241:    Notes:
1242:    Not for use in Fortran

1244:    Level: advanced
1245: @*/
1246: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1247: {
1249:   PetscInt n = 0,evalue;
1250:   PetscBool efound;

1253:   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");
1254:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1255:   n -= 3; /* drop enum name, prefix, and null termination */
1256:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1257:   if (efound) *value = (PetscEnum)evalue;
1258:   if (found) *found = efound;
1259:   return(0);
1260: }