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:    Note:
 28:     this may be called before PetscInitialize() or after PetscFinalize()

 30:    Fortran Note:
 31:    Not for use in Fortran

 33:    Developer Notes:
 34:    Uses raw `malloc()` and does not call error handlers since this may be used before PETSc is initialized.

 36:    Used to generate argc, args arguments passed to `MPI_Init()`

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

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

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

 84:   for (i = 0; i < *argc; i++) {
 85:     (*args)[i] = (char *)malloc((lens[i] + 1) * sizeof(char));
 86:     if (!(*args)[i]) {
 87:       free(lens);
 88:       for (j = 0; j < i; j++) free((*args)[j]);
 89:       free(*args);
 90:       return PETSC_ERR_MEM;
 91:     }
 92:   }
 93:   free(lens);
 94:   (*args)[*argc] = NULL;

 96:   *argc = 0;
 97:   for (i = 0; i < n; i++) {
 98:     if (s[i] != sp) break;
 99:   }
100:   for (; i < n + 1; i++) {
101:     if ((s[i] == sp || s[i] == 0) && !flg) {
102:       flg                   = PETSC_TRUE;
103:       (*args)[*argc][cnt++] = 0;
104:       (*argc)++;
105:       cnt = 0;
106:     } else if (s[i] != sp && s[i] != 0) {
107:       (*args)[*argc][cnt++] = s[i];
108:       flg                   = PETSC_FALSE;
109:     }
110:   }
111:   return 0;
112: }

114: /*@C
115:    PetscStrToArrayDestroy - Frees array created with `PetscStrToArray()`.

117:    Not Collective

119:    Output Parameters:
120: +  argc - the number of arguments
121: -  args - the array of arguments

123:    Level: intermediate

125:    Note:
126:     This may be called before `PetscInitialize()` or after `PetscFinalize()`

128:    Fortran Note:
129:    Not for use in Fortran

131: .seealso: `PetscStrToArray()`
132: @*/
133: PetscErrorCode PetscStrToArrayDestroy(int argc, char **args)
134: {
135:   for (int i = 0; i < argc; ++i) free(args[i]);
136:   if (args) free(args);
137:   return 0;
138: }

140: /*@C
141:    PetscStrlen - Gets length of a string

143:    Not Collective

145:    Input Parameters:
146: .  s - pointer to string

148:    Output Parameter:
149: .  len - length in bytes

151:    Level: intermediate

153:    Note:
154:    This routine is analogous to `strlen()`.

156:    Null string returns a length of zero

158:    Fortran Note:
159:    Not for use in Fortran

161: .seealso: `PetscStrallocpy()`
162: @*/
163: PetscErrorCode PetscStrlen(const char s[], size_t *len)
164: {
165:   *len = s ? strlen(s) : 0;
166:   return 0;
167: }

169: /*@C
170:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string in the new space

172:    Not Collective

174:    Input Parameters:
175: .  s - pointer to string

177:    Output Parameter:
178: .  t - the copied string

180:    Level: intermediate

182:    Notes:
183:    Null string returns a new null string

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

188:    Fortran Note:
189:    Not for use in Fortran

191: .seealso: `PetscStrArrayallocpy()`, `PetscStrcpy()`, `PetscStrNArrayallocpy()`
192: @*/
193: PetscErrorCode PetscStrallocpy(const char s[], char *t[])
194: {
195:   char *tmp = NULL;

197:   if (s) {
198:     size_t len;

200:     PetscStrlen(s, &len);
201:     PetscMalloc1(1 + len, &tmp);
202:     PetscStrcpy(tmp, s);
203:   }
204:   *t = tmp;
205:   return 0;
206: }

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

211:    Not Collective

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

216:    Output Parameter:
217: .  t - the copied array string

219:    Level: intermediate

221:    Note:
222:    If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
223:    the array before calling this routine.

225:    Fortran Note:
226:    Not for use in Fortran

228: .seealso: `PetscStrallocpy()`, `PetscStrArrayDestroy()`, `PetscStrNArrayallocpy()`
229: @*/
230: PetscErrorCode PetscStrArrayallocpy(const char *const *list, char ***t)
231: {
232:   PetscInt n = 0;

234:   while (list[n++])
235:     ;
236:   PetscMalloc1(n + 1, t);
237:   for (PetscInt i = 0; i < n; i++) PetscStrallocpy(list[i], (*t) + i);
238:   (*t)[n] = NULL;
239:   return 0;
240: }

242: /*@C
243:    PetscStrArrayDestroy - Frees array of strings created with `PetscStrArrayallocpy()`.

245:    Not Collective

247:    Output Parameters:
248: .   list - array of strings

250:    Level: intermediate

252:    Fortran Note:
253:     Not for use in Fortran

255: .seealso: `PetscStrArrayallocpy()`
256: @*/
257: PetscErrorCode PetscStrArrayDestroy(char ***list)
258: {
259:   PetscInt n = 0;

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

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

273:    Not Collective

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

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

282:    Level: intermediate

284:    Fortran Note:
285:       Not for use in Fortran

287: .seealso: `PetscStrallocpy()`, `PetscStrArrayallocpy()`, `PetscStrNArrayDestroy()`
288: @*/
289: PetscErrorCode PetscStrNArrayallocpy(PetscInt n, const char *const *list, char ***t)
290: {
291:   PetscMalloc1(n, t);
292:   for (PetscInt i = 0; i < n; i++) PetscStrallocpy(list[i], (*t) + i);
293:   return 0;
294: }

296: /*@C
297:    PetscStrNArrayDestroy - Frees array of strings created with `PetscStrNArrayallocpy()`.

299:    Not Collective

301:    Output Parameters:
302: +   n - number of string entries
303: -   list - array of strings

305:    Level: intermediate

307:    Fortran Note:
308:     Not for use in Fortran

310: .seealso: `PetscStrNArrayallocpy()`, `PetscStrArrayallocpy()`
311: @*/
312: PetscErrorCode PetscStrNArrayDestroy(PetscInt n, char ***list)
313: {
314:   if (!*list) return 0;
315:   for (PetscInt i = 0; i < n; i++) PetscFree((*list)[i]);
316:   PetscFree(*list);
317:   return 0;
318: }

320: /*@C
321:    PetscStrcpy - Copies a string

323:    Not Collective

325:    Input Parameters:
326: .  t - pointer to string

328:    Output Parameter:
329: .  s - the copied string

331:    Level: intermediate

333:    Notes:
334:      Null string returns a string starting with zero

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

338:    Fortran Note:
339:     Not for use in Fortran

341: .seealso: `PetscStrncpy()`, `PetscStrcat()`, `PetscStrlcat()`, `PetscStrallocpy()`
342: @*/

344: PetscErrorCode PetscStrcpy(char s[], const char t[])
345: {
346:   if (t) {
349:     strcpy(s, t);
350:   } else if (s) s[0] = 0;
351:   return 0;
352: }

354: /*@C
355:    PetscStrncpy - Copies a string up to a certain length

357:    Not Collective

359:    Input Parameters:
360: +  t - pointer to string
361: -  n - the length to copy

363:    Output Parameter:
364: .  s - the copied string

366:    Level: intermediate

368:    Note:
369:      Null string returns a string starting with zero

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

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

378: .seealso: `PetscStrcpy()`, `PetscStrcat()`, `PetscStrlcat()`, `PetscStrallocpy()`
379: @*/
380: PetscErrorCode PetscStrncpy(char s[], const char t[], size_t n)
381: {
383:   if (t) {
385:     if (n > 1) {
386:       strncpy(s, t, n - 1);
387:       s[n - 1] = '\0';
388:     } else {
389:       s[0] = '\0';
390:     }
391:   } else if (s) s[0] = 0;
392:   return 0;
393: }

395: /*@C
396:    PetscStrcat - Concatenates a string onto a given string

398:    Not Collective

400:    Input Parameters:
401: +  s - string to be added to
402: -  t - pointer to string to be added to end

404:    Level: intermediate

406:    Note:
407:     It is recommended you use `PetscStrlcat()` instead of this routine

409:    Fortran Note:
410:     Not for use in Fortran

412: .seealso: `PetscStrcpy()`, `PetscStrncpy()`, `PetscStrlcat()`
413: @*/
414: PetscErrorCode PetscStrcat(char s[], const char t[])
415: {
416:   if (!t) return 0;
419:   strcat(s, t);
420:   return 0;
421: }

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

426:    Not Collective

428:    Input Parameters:
429: +  s - pointer to string to be added to at end
430: .  t - string to be added
431: -  n - length of the original allocated string

433:    Level: intermediate

435:   Note:
436:   Unlike the system call `strncat()`, the length passed in is the length of the
437:   original allocated space, not the length of the left-over space. This is
438:   similar to the BSD system call `strlcat()`.

440:   Fortran Note:
441:   Not for use in Fortran

443: .seealso: `PetscStrcpy()`, `PetscStrncpy()`, `PetscStrcat()`
444: @*/
445: PetscErrorCode PetscStrlcat(char s[], const char t[], size_t n)
446: {
447:   size_t len;

449:   if (!t) return 0;
453:   PetscStrlen(t, &len);
454:   strncat(s, t, n - len);
455:   s[n - 1] = 0;
456:   return 0;
457: }

459: void PetscStrcmpNoError(const char a[], const char b[], PetscBool *flg)
460: {
461:   if (!a && !b) *flg = PETSC_TRUE;
462:   else if (!a || !b) *flg = PETSC_FALSE;
463:   else *flg = strcmp(a, b) ? PETSC_FALSE : PETSC_TRUE;
464: }

466: /*@C
467:    PetscBasename - returns a pointer to the last entry of a / or \ separated directory path

469:    Not Collective

471:    Input Parameter:
472: .  a - pointer to string

474:    Level: intermediate

476:    Fortran Note:
477:     Not for use in Fortran

479: .seealso: `PetscStrgrt()`, `PetscStrncmp()`, `PetscStrcasecmp()`, `PetscStrrchr()`, `PetscStrcmp()`, `PetscStrstr()`,
480:           `PetscTokenCreate()`, `PetscStrToArray()`, `PetscStrInList()`
481: @*/
482: const char *PetscBasename(const char a[])
483: {
484:   const char *ptr;

486:   if (PetscStrrchr(a, '/', (char **)&ptr)) ptr = NULL;
487:   if (ptr == a) {
488:     if (PetscStrrchr(a, '\\', (char **)&ptr)) ptr = NULL;
489:   }
490:   return ptr;
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:    Fortran Note:
508:     Not for use in Fortran

510: .seealso: `PetscStrgrt()`, `PetscStrncmp()`, `PetscStrcasecmp()`
511: @*/
512: PetscErrorCode PetscStrcmp(const char a[], const char b[], PetscBool *flg)
513: {
515:   if (!a && !b) *flg = PETSC_TRUE;
516:   else if (!a || !b) *flg = PETSC_FALSE;
517:   else *flg = (PetscBool)!strcmp(a, b);
518:   return 0;
519: }

521: /*@C
522:    PetscStrgrt - If first string is greater than the second

524:    Not Collective

526:    Input Parameters:
527: +  a - pointer to first string
528: -  b - pointer to second string

530:    Output Parameter:
531: .  flg - if the first string is greater

533:    Note:
534:     Null arguments are ok, a null string is considered smaller than
535:     all others

537:    Fortran Note:
538:    Not for use in Fortran

540:    Level: intermediate

542: .seealso: `PetscStrcmp()`, `PetscStrncmp()`, `PetscStrcasecmp()`
543: @*/
544: PetscErrorCode PetscStrgrt(const char a[], const char b[], PetscBool *t)
545: {
547:   if (!a && !b) *t = PETSC_FALSE;
548:   else if (a && !b) *t = PETSC_TRUE;
549:   else if (!a && b) *t = PETSC_FALSE;
550:   else {
553:     *t = strcmp(a, b) > 0 ? PETSC_TRUE : PETSC_FALSE;
554:   }
555:   return 0;
556: }

558: /*@C
559:    PetscStrcasecmp - Returns true if the two strings are the same
560:      except possibly for case.

562:    Not Collective

564:    Input Parameters:
565: +  a - pointer to first string
566: -  b - pointer to second string

568:    Output Parameter:
569: .  flg - if the two strings are the same

571:    Note:
572:     Null arguments are ok

574:    Fortran Note:
575:    Not for use in Fortran

577:    Level: intermediate

579: .seealso: `PetscStrcmp()`, `PetscStrncmp()`, `PetscStrgrt()`
580: @*/
581: PetscErrorCode PetscStrcasecmp(const char a[], const char b[], PetscBool *t)
582: {
583:   int c;

586:   if (!a && !b) c = 0;
587:   else if (!a || !b) c = 1;
588: #if defined(PETSC_HAVE_STRCASECMP)
589:   else c = strcasecmp(a, b);
590: #elif defined(PETSC_HAVE_STRICMP)
591:   else c = stricmp(a, b);
592: #else
593:   else {
594:     char *aa, *bb;
595:     PetscStrallocpy(a, &aa);
596:     PetscStrallocpy(b, &bb);
597:     PetscStrtolower(aa);
598:     PetscStrtolower(bb);
599:     PetscStrcmp(aa, bb, t);
600:     PetscFree(aa);
601:     PetscFree(bb);
602:     return 0;
603:   }
604: #endif
605:   *t = c ? PETSC_FALSE : PETSC_TRUE;
606:   return 0;
607: }

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

612:    Not Collective

614:    Input Parameters:
615: +  a - pointer to first string
616: .  b - pointer to second string
617: -  n - length to compare up to

619:    Output Parameter:
620: .  t - if the two strings are equal

622:    Level: intermediate

624:    Fortran Note:
625:     Not for use in Fortran

627: .seealso: `PetscStrgrt()`, `PetscStrcmp()`, `PetscStrcasecmp()`
628: @*/
629: PetscErrorCode PetscStrncmp(const char a[], const char b[], size_t n, PetscBool *t)
630: {
631:   if (n) {
634:   }
636:   *t = strncmp(a, b, n) ? PETSC_FALSE : PETSC_TRUE;
637:   return 0;
638: }

640: /*@C
641:    PetscStrchr - Locates first occurrence of a character in a string

643:    Not Collective

645:    Input Parameters:
646: +  a - pointer to string
647: -  b - character

649:    Output Parameter:
650: .  c - location of occurrence, NULL if not found

652:    Level: intermediate

654:    Fortran Note:
655:     Not for use in Fortran

657: .seealso: `PetscStrrchr()`, `PetscTokenCreate()`, `PetscStrendswith()`, `PetscStrbeginsswith()`
658: @*/
659: PetscErrorCode PetscStrchr(const char a[], char b, char *c[])
660: {
663:   *c = (char *)strchr(a, b);
664:   return 0;
665: }

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

671:    Not Collective

673:    Input Parameters:
674: +  a - pointer to string
675: -  b - character

677:    Output Parameter:
678: .  tmp - location of occurrence, a if not found

680:    Level: intermediate

682:    Fortran Note:
683:     Not for use in Fortran

685: .seealso: `PetscStrchr()`, `PetscTokenCreate()`, `PetscStrendswith()`, `PetscStrbeginsswith()`
686: @*/
687: PetscErrorCode PetscStrrchr(const char a[], char b, char *tmp[])
688: {
691:   *tmp = (char *)strrchr(a, b);
692:   if (!*tmp) *tmp = (char *)a;
693:   else *tmp = *tmp + 1;
694:   return 0;
695: }

697: /*@C
698:    PetscStrtolower - Converts string to lower case

700:    Not Collective

702:    Input Parameters:
703: .  a - pointer to string

705:    Level: intermediate

707:    Fortran Note:
708:     Not for use in Fortran

710: .seealso: `PetscStrtoupper()`
711: @*/
712: PetscErrorCode PetscStrtolower(char a[])
713: {
715:   while (*a) {
716:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
717:     a++;
718:   }
719:   return 0;
720: }

722: /*@C
723:    PetscStrtoupper - Converts string to upper case

725:    Not Collective

727:    Input Parameters:
728: .  a - pointer to string

730:    Level: intermediate

732:    Fortran Note:
733:     Not for use in Fortran

735: .seealso: `PetscStrtolower()`
736: @*/
737: PetscErrorCode PetscStrtoupper(char a[])
738: {
740:   while (*a) {
741:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
742:     a++;
743:   }
744:   return 0;
745: }

747: /*@C
748:    PetscStrendswith - Determines if a string ends with a certain string

750:    Not Collective

752:    Input Parameters:
753: +  a - pointer to string
754: -  b - string to endwith

756:    Output Parameter:
757: .  flg - `PETSC_TRUE` or `PETSC_FALSE`

759:    Fortran Note:
760:     Not for use in Fortran

762:    Level: intermediate

764: .seealso: `PetscStrendswithwhich()`, `PetscStrbeginswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`,
765:           `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()`
766: @*/
767: PetscErrorCode PetscStrendswith(const char a[], const char b[], PetscBool *flg)
768: {
769:   char *test;

772:   *flg = PETSC_FALSE;
773:   PetscStrrstr(a, b, &test);
774:   if (test) {
775:     size_t na, nb;

777:     PetscStrlen(a, &na);
778:     PetscStrlen(b, &nb);
779:     if (a + na - nb == test) *flg = PETSC_TRUE;
780:   }
781:   return 0;
782: }

784: /*@C
785:    PetscStrbeginswith - Determines if a string begins with a certain string

787:    Not Collective

789:    Input Parameters:
790: +  a - pointer to string
791: -  b - string to begin with

793:    Output Parameter:
794: .  flg - PETSC_TRUE or PETSC_FALSE

796:    Fortran Note:
797:     Not for use in Fortran

799:    Level: intermediate

801: .seealso: `PetscStrendswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`,
802:           `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()`
803: @*/
804: PetscErrorCode PetscStrbeginswith(const char a[], const char b[], PetscBool *flg)
805: {
806:   char *test;

811:   *flg = PETSC_FALSE;
812:   PetscStrrstr(a, b, &test);
813:   if (test && (test == a)) *flg = PETSC_TRUE;
814:   return 0;
815: }

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

820:    Not Collective

822:    Input Parameters:
823: +  a - pointer to string
824: -  bs - strings to end with (last entry must be NULL)

826:    Output Parameter:
827: .  cnt - the index of the string it ends with or the index of NULL

829:    Fortran Note:
830:     Not for use in Fortran

832:    Level: intermediate

834: .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`,
835:           `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()`
836: @*/
837: PetscErrorCode PetscStrendswithwhich(const char a[], const char *const *bs, PetscInt *cnt)
838: {
841:   *cnt = 0;
842:   while (bs[*cnt]) {
843:     PetscBool flg;

845:     PetscStrendswith(a, bs[*cnt], &flg);
846:     if (flg) return 0;
847:     ++(*cnt);
848:   }
849:   return 0;
850: }

852: /*@C
853:    PetscStrrstr - Locates last occurrence of string in another string

855:    Not Collective

857:    Input Parameters:
858: +  a - pointer to string
859: -  b - string to find

861:    Output Parameter:
862: .  tmp - location of occurrence

864:    Fortran Note:
865:     Not for use in Fortran

867:    Level: intermediate

869: .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`,
870:           `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()`
871: @*/
872: PetscErrorCode PetscStrrstr(const char a[], const char b[], char *tmp[])
873: {
874:   const char *ltmp = NULL;

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

887: /*@C
888:    PetscStrstr - Locates first occurrence of string in another string

890:    Not Collective

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

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

899:    Fortran Note:
900:     Not for use in Fortran

902:    Level: intermediate

904: .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`,
905:           `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()`
906: @*/
907: PetscErrorCode PetscStrstr(const char haystack[], const char needle[], char *tmp[])
908: {
912:   *tmp = (char *)strstr(haystack, needle);
913:   return 0;
914: }

916: struct _p_PetscToken {
917:   char  token;
918:   char *array;
919:   char *current;
920: };

922: /*@C
923:    PetscTokenFind - Locates next "token" in a string

925:    Not Collective

927:    Input Parameters:
928: .  a - pointer to token

930:    Output Parameter:
931: .  result - location of occurrence, NULL if not found

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

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

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

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

945:    Fortran Note:
946:     Not for use in Fortran

948:    Level: intermediate

950: .seealso: `PetscTokenCreate()`, `PetscTokenDestroy()`
951: @*/
952: PetscErrorCode PetscTokenFind(PetscToken a, char *result[])
953: {
954:   char *ptr, token;

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

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

988:    Not Collective

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

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

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

1004:    Level: intermediate

1006: .seealso: `PetscTokenFind()`, `PetscTokenDestroy()`
1007: @*/
1008: PetscErrorCode PetscTokenCreate(const char a[], const char b, PetscToken *t)
1009: {
1012:   PetscNew(t);
1013:   PetscStrallocpy(a, &(*t)->array);

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

1020: /*@C
1021:    PetscTokenDestroy - Destroys a `PetscToken`

1023:    Not Collective

1025:    Input Parameters:
1026: .  a - pointer to token

1028:    Level: intermediate

1030:    Fortran Note:
1031:     Not for use in Fortran

1033: .seealso: `PetscTokenCreate()`, `PetscTokenFind()`
1034: @*/
1035: PetscErrorCode PetscTokenDestroy(PetscToken *a)
1036: {
1037:   if (!*a) return 0;
1038:   PetscFree((*a)->array);
1039:   PetscFree(*a);
1040:   return 0;
1041: }

1043: /*@C
1044:    PetscStrInList - search for string in character-delimited list

1046:    Not Collective

1048:    Input Parameters:
1049: +  str - the string to look for
1050: .  list - the list to search in
1051: -  sep - the separator character

1053:    Output Parameter:
1054: .  found - whether str is in list

1056:    Level: intermediate

1058:    Fortran Note:
1059:     Not for use in Fortran

1061: .seealso: `PetscTokenCreate()`, `PetscTokenFind()`, `PetscStrcmp()`
1062: @*/
1063: PetscErrorCode PetscStrInList(const char str[], const char list[], char sep, PetscBool *found)
1064: {
1065:   PetscToken token;
1066:   char      *item;

1069:   *found = PETSC_FALSE;
1070:   PetscTokenCreate(list, sep, &token);
1071:   PetscTokenFind(token, &item);
1072:   while (item) {
1073:     PetscStrcmp(str, item, found);
1074:     if (*found) break;
1075:     PetscTokenFind(token, &item);
1076:   }
1077:   PetscTokenDestroy(&token);
1078:   return 0;
1079: }

1081: /*@C
1082:    PetscGetPetscDir - Gets the directory PETSc is installed in

1084:    Not Collective

1086:    Output Parameter:
1087: .  dir - the directory

1089:    Level: developer

1091:    Fortran Note:
1092:     Not for use in Fortran

1094: @*/
1095: PetscErrorCode PetscGetPetscDir(const char *dir[])
1096: {
1098:   *dir = PETSC_DIR;
1099:   return 0;
1100: }

1102: /*@C
1103:    PetscStrreplace - Replaces substrings in string with other substrings

1105:    Not Collective

1107:    Input Parameters:
1108: +   comm - `MPI_Comm` of processors that are processing the string
1109: .   aa - the string to look in
1110: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1111: -   len - the length of b

1113:    Notes:
1114:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1115:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1116:       as well as any environmental variables.

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

1121:    Fortran Note:
1122:       Not for use in Fortran

1124:    Level: developer

1126: @*/
1127: PetscErrorCode PetscStrreplace(MPI_Comm comm, const char aa[], char b[], size_t len)
1128: {
1129:   int           i = 0;
1130:   size_t        l, l1, l2, l3;
1131:   char         *work, *par, *epar, env[1024], *tfree, *a = (char *)aa;
1132:   const char   *s[] = {"${PETSC_ARCH}", "${PETSC_DIR}", "${PETSC_LIB_DIR}", "${DISPLAY}", "${HOMEDIRECTORY}", "${WORKINGDIRECTORY}", "${USERNAME}", "${HOSTNAME}", NULL};
1133:   char         *r[] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL};
1134:   PetscBool     flag;
1135:   static size_t DISPLAY_LENGTH = 265, USER_LENGTH = 256, HOST_LENGTH = 256;

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

1142:   /* get values for replaced variables */
1143:   PetscStrallocpy(PETSC_ARCH, &r[0]);
1144:   PetscStrallocpy(PETSC_DIR, &r[1]);
1145:   PetscStrallocpy(PETSC_LIB_DIR, &r[2]);
1146:   PetscMalloc1(DISPLAY_LENGTH, &r[3]);
1147:   PetscMalloc1(PETSC_MAX_PATH_LEN, &r[4]);
1148:   PetscMalloc1(PETSC_MAX_PATH_LEN, &r[5]);
1149:   PetscMalloc1(USER_LENGTH, &r[6]);
1150:   PetscMalloc1(HOST_LENGTH, &r[7]);
1151:   PetscGetDisplay(r[3], DISPLAY_LENGTH);
1152:   PetscGetHomeDirectory(r[4], PETSC_MAX_PATH_LEN);
1153:   PetscGetWorkingDirectory(r[5], PETSC_MAX_PATH_LEN);
1154:   PetscGetUserName(r[6], USER_LENGTH);
1155:   PetscGetHostName(r[7], HOST_LENGTH);

1157:   /* replace that are in environment */
1158:   PetscOptionsGetenv(comm, "PETSC_LIB_DIR", env, sizeof(env), &flag);
1159:   if (flag) {
1160:     PetscFree(r[2]);
1161:     PetscStrallocpy(env, &r[2]);
1162:   }

1164:   /* replace the requested strings */
1165:   PetscStrncpy(b, a, len);
1166:   while (s[i]) {
1167:     PetscStrlen(s[i], &l);
1168:     PetscStrstr(b, s[i], &par);
1169:     while (par) {
1170:       *par = 0;
1171:       par += l;

1173:       PetscStrlen(b, &l1);
1174:       PetscStrlen(r[i], &l2);
1175:       PetscStrlen(par, &l3);
1177:       PetscStrncpy(work, b, len);
1178:       PetscStrlcat(work, r[i], len);
1179:       PetscStrlcat(work, par, len);
1180:       PetscStrncpy(b, work, len);
1181:       PetscStrstr(b, s[i], &par);
1182:     }
1183:     i++;
1184:   }
1185:   i = 0;
1186:   while (r[i]) {
1187:     tfree = (char *)r[i];
1188:     PetscFree(tfree);
1189:     i++;
1190:   }

1192:   /* look for any other ${xxx} strings to replace from environmental variables */
1193:   PetscStrstr(b, "${", &par);
1194:   while (par) {
1195:     *par = 0;
1196:     par += 2;
1197:     PetscStrncpy(work, b, len);
1198:     PetscStrstr(par, "}", &epar);
1199:     *epar = 0;
1200:     epar += 1;
1201:     PetscOptionsGetenv(comm, par, env, sizeof(env), &flag);
1203:     PetscStrlcat(work, env, len);
1204:     PetscStrlcat(work, epar, len);
1205:     PetscStrncpy(b, work, len);
1206:     PetscStrstr(b, "${", &par);
1207:   }
1208:   PetscFree(work);
1209:   if (aa == b) PetscFree(a);
1210:   return 0;
1211: }

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

1216:    Not Collective

1218:    Input Parameters:
1219: +  n - number of strings in
1220: .  list - list of strings to search
1221: -  str - string to look for, empty string "" accepts default (first entry in list)

1223:    Output Parameters:
1224: +  value - index of matching string (if found)
1225: -  found - boolean indicating whether string was found (can be NULL)

1227:    Fortran Note:
1228:    Not for use in Fortran

1230:    Level: advanced

1232: .seealso: `PetscEnumFind()`
1233: @*/
1234: PetscErrorCode PetscEListFind(PetscInt n, const char *const *list, const char *str, PetscInt *value, PetscBool *found)
1235: {
1236:   if (found) {
1238:     *found = PETSC_FALSE;
1239:   }
1240:   for (PetscInt i = 0; i < n; ++i) {
1241:     PetscBool matched;

1243:     PetscStrcasecmp(str, list[i], &matched);
1244:     if (matched || !str[0]) {
1245:       if (found) *found = PETSC_TRUE;
1246:       *value = i;
1247:       break;
1248:     }
1249:   }
1250:   return 0;
1251: }

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

1256:    Not Collective

1258:    Input Parameters:
1259: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1260: -  str - string to look for

1262:    Output Parameters:
1263: +  value - index of matching string (if found)
1264: -  found - boolean indicating whether string was found (can be NULL)

1266:    Fortran Note:
1267:    Not for use in Fortran

1269:    Level: advanced

1271: .seealso: `PetscEListFind()`
1272: @*/
1273: PetscErrorCode PetscEnumFind(const char *const *enumlist, const char *str, PetscEnum *value, PetscBool *found)
1274: {
1275:   PetscInt  n = 0, evalue;
1276:   PetscBool efound;

1281:   n -= 3; /* drop enum name, prefix, and null termination */
1282:   PetscEListFind(n, enumlist, str, &evalue, &efound);
1283:   if (efound) {
1285:     *value = (PetscEnum)evalue;
1286:   }
1287:   if (found) {
1289:     *found = efound;
1290:   }
1291:   return 0;
1292: }

1294: /*@C
1295:   PetscCIFilename - returns the basename of a file name when the PETSc CI portable error output mode is enabled.

1297:   Not collective

1299:   Input Parameter:
1300: . file - the file name

1302:   Note:
1303:   PETSc CI mode is a mode of running PETSc where output (both error and non-error) is made portable across all systems
1304:   so that comparisons of output between runs are easy to make.

1306:   This mode is used for all tests in the test harness, it applies to both debug and optimized builds.

1308:   Use the option -petsc_ci to turn on PETSc CI mode. It changes certain output in non-error situations to be portable for
1309:   all systems, mainly the output of options. It is passed to all PETSc programs automatically by the test harness.

1311:   Always uses the Unix / as the file separate even on Microsoft Windows systems

1313:   The option -petsc_ci_portable_error_output attempts to output the same error messages on all systems for the test harness.
1314:   In particular the output of filenames and line numbers in PETSc stacks. This is to allow (limited) checking of PETSc
1315:   error handling by the test harness. This options also causes PETSc to attempt to return an error code of 0 so that the test
1316:   harness can process the output for differences in the usual manner as for successful runs. It should be provided to the test
1317:   harness in the args: argument for specific examples. It will not necessarily produce portable output if different errors
1318:   (or no errors) occur on a subset of the MPI ranks.

1320:   Level: developer

1322: .seealso: `PetscCILinenumber()`
1323: @*/
1324: const char *PetscCIFilename(const char *file)
1325: {
1326:   if (!PetscCIEnabledPortableErrorOutput) return file;
1327:   return PetscBasename(file);
1328: }

1330: /*@C
1331:   PetscCILinenumber - returns a line number except if `PetscCIEnablePortableErrorOutput` is set when it returns 0

1333:   Not collective

1335:   Input Parameter:
1336: . linenumber - the initial line number

1338:   Note:
1339:   See `PetscCIFilename()` for details on usage

1341:   Level: developer

1343: .seealso: `PetscCIFilename()`
1344: @*/
1345: int PetscCILinenumber(int linenumber)
1346: {
1347:   if (!PetscCIEnabledPortableErrorOutput) return linenumber;
1348:   return 0;
1349: }