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