Actual source code: str.c
petsc-3.13.6 2020-09-29
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 <petscsys.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 Parameter:
22: + argc - the number of entries in the array
23: - args - an array of the entries with a null at the end
25: Level: intermediate
27: Notes:
28: this may be called before PetscInitialize() or after PetscFinalize()
30: Not for use in Fortran
32: Developer Notes:
33: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
34: to generate argc, args arguments passed to MPI_Init()
36: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
38: @*/
39: PetscErrorCode PetscStrToArray(const char s[],char sp,int *argc,char ***args)
40: {
41: int i,j,n,*lens,cnt = 0;
42: PetscBool flg = PETSC_FALSE;
44: if (!s) n = 0;
45: else n = strlen(s);
46: *argc = 0;
47: *args = NULL;
48: for (; n>0; n--) { /* remove separator chars at the end - and will empty the string if all chars are separator chars */
49: if (s[n-1] != sp) break;
50: }
51: if (!n) {
52: return(0);
53: }
54: for (i=0; i<n; i++) {
55: if (s[i] != sp) break;
56: }
57: for (;i<n+1; i++) {
58: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
59: else if (s[i] != sp) {flg = PETSC_FALSE;}
60: }
61: (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
62: lens = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
63: for (i=0; i<*argc; i++) lens[i] = 0;
65: *argc = 0;
66: for (i=0; i<n; i++) {
67: if (s[i] != sp) break;
68: }
69: for (;i<n+1; i++) {
70: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
71: else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
72: }
74: for (i=0; i<*argc; i++) {
75: (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
76: if (!(*args)[i]) {
77: free(lens);
78: for (j=0; j<i; j++) free((*args)[j]);
79: free(*args);
80: return PETSC_ERR_MEM;
81: }
82: }
83: free(lens);
84: (*args)[*argc] = NULL;
86: *argc = 0;
87: for (i=0; i<n; i++) {
88: if (s[i] != sp) break;
89: }
90: for (;i<n+1; i++) {
91: if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
92: else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
93: }
94: return 0;
95: }
97: /*@C
98: PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
100: Not Collective
102: Output Parameters:
103: + argc - the number of arguments
104: - args - the array of arguments
106: Level: intermediate
108: Notes:
109: This may be called before PetscInitialize() or after PetscFinalize()
111: Not for use in Fortran
113: .seealso: PetscStrToArray()
115: @*/
116: PetscErrorCode PetscStrToArrayDestroy(int argc,char **args)
117: {
118: PetscInt i;
120: for (i=0; i<argc; i++) free(args[i]);
121: if (args) free(args);
122: return 0;
123: }
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: @*/
146: PetscErrorCode PetscStrlen(const char s[],size_t *len)
147: {
149: if (!s) *len = 0;
150: else *len = strlen(s);
151: return(0);
152: }
154: /*@C
155: PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
157: Not Collective
159: Input Parameters:
160: . s - pointer to string
162: Output Parameter:
163: . t - the copied string
165: Level: intermediate
167: Note:
168: Null string returns a new null string
170: Not for use in Fortran
171:
172: Warning: If t has previously been allocated then that memory is lost, you may need to PetscFree()
173: the array before calling this routine.
175: .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()
177: @*/
178: PetscErrorCode PetscStrallocpy(const char s[],char *t[])
179: {
181: size_t len;
182: char *tmp = NULL;
185: if (s) {
186: PetscStrlen(s,&len);
187: PetscMalloc1(1+len,&tmp);
188: PetscStrcpy(tmp,s);
189: }
190: *t = tmp;
191: return(0);
192: }
194: /*@C
195: PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
197: Not Collective
199: Input Parameters:
200: . s - pointer to array of strings (final string is a null)
202: Output Parameter:
203: . t - the copied array string
205: Level: intermediate
207: Note:
208: Not for use in Fortran
210: Warning: If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
211: the array before calling this routine.
212:
213: .seealso: PetscStrallocpy(), PetscStrArrayDestroy(), PetscStrNArrayallocpy()
215: @*/
216: PetscErrorCode PetscStrArrayallocpy(const char *const *list,char ***t)
217: {
219: PetscInt i,n = 0;
222: while (list[n++]) ;
223: PetscMalloc1(n+1,t);
224: for (i=0; i<n; i++) {
225: PetscStrallocpy(list[i],(*t)+i);
226: }
227: (*t)[n] = NULL;
228: return(0);
229: }
231: /*@C
232: PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
234: Not Collective
236: Output Parameters:
237: . list - array of strings
239: Level: intermediate
241: Notes:
242: Not for use in Fortran
244: .seealso: PetscStrArrayallocpy()
246: @*/
247: PetscErrorCode PetscStrArrayDestroy(char ***list)
248: {
249: PetscInt n = 0;
253: if (!*list) return(0);
254: while ((*list)[n]) {
255: PetscFree((*list)[n]);
256: n++;
257: }
258: PetscFree(*list);
259: return(0);
260: }
262: /*@C
263: PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
265: Not Collective
267: Input Parameters:
268: + n - the number of string entries
269: - s - pointer to array of strings
271: Output Parameter:
272: . t - the copied array string
274: Level: intermediate
276: Note:
277: Not for use in Fortran
279: .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()
281: @*/
282: PetscErrorCode PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
283: {
285: PetscInt i;
288: PetscMalloc1(n,t);
289: for (i=0; i<n; i++) {
290: PetscStrallocpy(list[i],(*t)+i);
291: }
292: return(0);
293: }
295: /*@C
296: PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
298: Not Collective
300: Output Parameters:
301: + n - number of string entries
302: - list - array of strings
304: Level: intermediate
306: Notes:
307: Not for use in Fortran
309: .seealso: PetscStrArrayallocpy()
311: @*/
312: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
313: {
315: PetscInt i;
318: if (!*list) return(0);
319: for (i=0; i<n; i++){
320: PetscFree((*list)[i]);
321: }
322: PetscFree(*list);
323: return(0);
324: }
326: /*@C
327: PetscStrcpy - Copies a string
329: Not Collective
331: Input Parameters:
332: . t - pointer to string
334: Output Parameter:
335: . s - the copied string
337: Level: intermediate
339: Notes:
340: Null string returns a string starting with zero
342: Not for use in Fortran
343:
344: It is recommended you use PetscStrncpy() instead of this routine
346: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
348: @*/
350: PetscErrorCode PetscStrcpy(char s[],const char t[])
351: {
353: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
354: if (t) strcpy(s,t);
355: else if (s) s[0] = 0;
356: return(0);
357: }
359: /*@C
360: PetscStrncpy - Copies a string up to a certain length
362: Not Collective
364: Input Parameters:
365: + t - pointer to string
366: - n - the length to copy
368: Output Parameter:
369: . s - the copied string
371: Level: intermediate
373: Note:
374: Null string returns a string starting with zero
376: If the string that is being copied is of length n or larger then the entire string is not
377: copied and the final location of s is set to NULL. This is different then the behavior of
378: strncpy() which leaves s non-terminated if there is not room for the entire string.
380: Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
382: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
384: @*/
385: PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
386: {
388: if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
389: if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
390: if (t) {
391: if (n > 1) {
392: strncpy(s,t,n-1);
393: s[n-1] = '\0';
394: } else {
395: s[0] = '\0';
396: }
397: } else if (s) s[0] = 0;
398: return(0);
399: }
401: /*@C
402: PetscStrcat - Concatenates a string onto a given string
404: Not Collective
406: Input Parameters:
407: + s - string to be added to
408: - t - pointer to string to be added to end
410: Level: intermediate
412: Notes:
413: Not for use in Fortran
414:
415: It is recommended you use PetscStrlcat() instead of this routine
417: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
419: @*/
420: PetscErrorCode PetscStrcat(char s[],const char t[])
421: {
423: if (!t) return(0);
424: strcat(s,t);
425: return(0);
426: }
428: /*@C
429: PetscStrlcat - Concatenates a string onto a given string, up to a given length
431: Not Collective
433: Input Parameters:
434: + s - pointer to string to be added to at end
435: . t - string to be added to
436: - n - length of the original allocated string
438: Level: intermediate
440: Notes:
441: Not for use in Fortran
443: Unlike the system call strncat(), the length passed in is the length of the
444: original allocated space, not the length of the left-over space. This is
445: similar to the BSD system call strlcat().
447: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
449: @*/
450: PetscErrorCode PetscStrlcat(char s[],const char t[],size_t n)
451: {
452: size_t len;
456: if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
457: if (!t) return(0);
458: PetscStrlen(t,&len);
459: strncat(s,t,n - len);
460: s[n-1] = 0;
461: return(0);
462: }
464: void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg)
465: {
466: int c;
468: if (!a && !b) *flg = PETSC_TRUE;
469: else if (!a || !b) *flg = PETSC_FALSE;
470: else {
471: c = strcmp(a,b);
472: if (c) *flg = PETSC_FALSE;
473: else *flg = PETSC_TRUE;
474: }
475: }
477: /*@C
478: PetscStrcmp - Compares two strings,
480: Not Collective
482: Input Parameters:
483: + a - pointer to string first string
484: - b - pointer to second string
486: Output Parameter:
487: . flg - PETSC_TRUE if the two strings are equal
489: Level: intermediate
491: Notes:
492: Not for use in Fortran
494: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
496: @*/
497: PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
498: {
499: int c;
502: if (!a && !b) *flg = PETSC_TRUE;
503: else if (!a || !b) *flg = PETSC_FALSE;
504: else {
505: c = strcmp(a,b);
506: if (c) *flg = PETSC_FALSE;
507: else *flg = PETSC_TRUE;
508: }
509: return(0);
510: }
512: /*@C
513: PetscStrgrt - If first string is greater than the second
515: Not Collective
517: Input Parameters:
518: + a - pointer to first string
519: - b - pointer to second string
521: Output Parameter:
522: . flg - if the first string is greater
524: Notes:
525: Null arguments are ok, a null string is considered smaller than
526: all others
528: Not for use in Fortran
530: Level: intermediate
532: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
534: @*/
535: PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
536: {
537: int c;
540: if (!a && !b) *t = PETSC_FALSE;
541: else if (a && !b) *t = PETSC_TRUE;
542: else if (!a && b) *t = PETSC_FALSE;
543: else {
544: c = strcmp(a,b);
545: if (c > 0) *t = PETSC_TRUE;
546: else *t = PETSC_FALSE;
547: }
548: return(0);
549: }
551: /*@C
552: PetscStrcasecmp - Returns true if the two strings are the same
553: except possibly for case.
555: Not Collective
557: Input Parameters:
558: + a - pointer to first string
559: - b - pointer to second string
561: Output Parameter:
562: . flg - if the two strings are the same
564: Notes:
565: Null arguments are ok
567: Not for use in Fortran
569: Level: intermediate
571: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
573: @*/
574: PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
575: {
576: int c;
579: if (!a && !b) c = 0;
580: else if (!a || !b) c = 1;
581: #if defined(PETSC_HAVE_STRCASECMP)
582: else c = strcasecmp(a,b);
583: #elif defined(PETSC_HAVE_STRICMP)
584: else c = stricmp(a,b);
585: #else
586: else {
587: char *aa,*bb;
589: PetscStrallocpy(a,&aa);
590: PetscStrallocpy(b,&bb);
591: PetscStrtolower(aa);
592: PetscStrtolower(bb);
593: PetscStrcmp(aa,bb,t);
594: PetscFree(aa);
595: PetscFree(bb);
596: return(0);
597: }
598: #endif
599: if (!c) *t = PETSC_TRUE;
600: else *t = PETSC_FALSE;
601: return(0);
602: }
606: /*@C
607: PetscStrncmp - Compares two strings, up to a certain length
609: Not Collective
611: Input Parameters:
612: + a - pointer to first string
613: . b - pointer to second string
614: - n - length to compare up to
616: Output Parameter:
617: . t - if the two strings are equal
619: Level: intermediate
621: Notes:
622: Not for use in Fortran
624: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
626: @*/
627: PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
628: {
629: int c;
632: c = strncmp(a,b,n);
633: if (!c) *t = PETSC_TRUE;
634: else *t = PETSC_FALSE;
635: return(0);
636: }
638: /*@C
639: PetscStrchr - Locates first occurance of a character in a string
641: Not Collective
643: Input Parameters:
644: + a - pointer to string
645: - b - character
647: Output Parameter:
648: . c - location of occurance, NULL if not found
650: Level: intermediate
652: Notes:
653: Not for use in Fortran
655: @*/
656: PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
657: {
659: *c = (char*)strchr(a,b);
660: return(0);
661: }
663: /*@C
664: PetscStrrchr - Locates one location past the last occurance of a character in a string,
665: if the character is not found then returns entire string
667: Not Collective
669: Input Parameters:
670: + a - pointer to string
671: - b - character
673: Output Parameter:
674: . tmp - location of occurance, a if not found
676: Level: intermediate
678: Notes:
679: Not for use in Fortran
681: @*/
682: PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
683: {
685: *tmp = (char*)strrchr(a,b);
686: if (!*tmp) *tmp = (char*)a;
687: else *tmp = *tmp + 1;
688: return(0);
689: }
691: /*@C
692: PetscStrtolower - Converts string to lower case
694: Not Collective
696: Input Parameters:
697: . a - pointer to string
699: Level: intermediate
701: Notes:
702: Not for use in Fortran
704: @*/
705: PetscErrorCode PetscStrtolower(char a[])
706: {
708: while (*a) {
709: if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
710: a++;
711: }
712: return(0);
713: }
715: /*@C
716: PetscStrtoupper - Converts string to upper case
718: Not Collective
720: Input Parameters:
721: . a - pointer to string
723: Level: intermediate
725: Notes:
726: Not for use in Fortran
728: @*/
729: PetscErrorCode PetscStrtoupper(char a[])
730: {
732: while (*a) {
733: if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
734: a++;
735: }
736: return(0);
737: }
739: /*@C
740: PetscStrendswith - Determines if a string ends with a certain string
742: Not Collective
744: Input Parameters:
745: + a - pointer to string
746: - b - string to endwith
748: Output Parameter:
749: . flg - PETSC_TRUE or PETSC_FALSE
751: Notes:
752: Not for use in Fortran
754: Level: intermediate
756: @*/
757: PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
758: {
759: char *test;
761: size_t na,nb;
764: *flg = PETSC_FALSE;
765: PetscStrrstr(a,b,&test);
766: if (test) {
767: PetscStrlen(a,&na);
768: PetscStrlen(b,&nb);
769: if (a+na-nb == test) *flg = PETSC_TRUE;
770: }
771: return(0);
772: }
774: /*@C
775: PetscStrbeginswith - Determines if a string begins with a certain string
777: Not Collective
779: Input Parameters:
780: + a - pointer to string
781: - b - string to begin with
783: Output Parameter:
784: . flg - PETSC_TRUE or PETSC_FALSE
786: Notes:
787: Not for use in Fortran
789: Level: intermediate
791: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
792: PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
794: @*/
795: PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
796: {
797: char *test;
801: *flg = PETSC_FALSE;
802: PetscStrrstr(a,b,&test);
803: if (test && (test == a)) *flg = PETSC_TRUE;
804: return(0);
805: }
808: /*@C
809: PetscStrendswithwhich - Determines if a string ends with one of several possible strings
811: Not Collective
813: Input Parameters:
814: + a - pointer to string
815: - bs - strings to end with (last entry must be NULL)
817: Output Parameter:
818: . cnt - the index of the string it ends with or the index of NULL
820: Notes:
821: Not for use in Fortran
823: Level: intermediate
825: @*/
826: PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
827: {
828: PetscBool flg;
832: *cnt = 0;
833: while (bs[*cnt]) {
834: PetscStrendswith(a,bs[*cnt],&flg);
835: if (flg) return(0);
836: *cnt += 1;
837: }
838: return(0);
839: }
841: /*@C
842: PetscStrrstr - Locates last occurance of string in another string
844: Not Collective
846: Input Parameters:
847: + a - pointer to string
848: - b - string to find
850: Output Parameter:
851: . tmp - location of occurance
853: Notes:
854: Not for use in Fortran
856: Level: intermediate
858: @*/
859: PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
860: {
861: const char *stmp = a, *ltmp = NULL;
864: while (stmp) {
865: stmp = (char*)strstr(stmp,b);
866: if (stmp) {ltmp = stmp;stmp++;}
867: }
868: *tmp = (char*)ltmp;
869: return(0);
870: }
872: /*@C
873: PetscStrstr - Locates first occurance of string in another string
875: Not Collective
877: Input Parameters:
878: + haystack - string to search
879: - needle - string to find
881: Output Parameter:
882: . tmp - location of occurance, is a NULL if the string is not found
884: Notes:
885: Not for use in Fortran
887: Level: intermediate
889: @*/
890: PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
891: {
893: *tmp = (char*)strstr(haystack,needle);
894: return(0);
895: }
897: struct _p_PetscToken {char token;char *array;char *current;};
899: /*@C
900: PetscTokenFind - Locates next "token" in a string
902: Not Collective
904: Input Parameters:
905: . a - pointer to token
907: Output Parameter:
908: . result - location of occurance, NULL if not found
910: Notes:
912: This version is different from the system version in that
913: it allows you to pass a read-only string into the function.
915: This version also treats all characters etc. inside a double quote "
916: as a single token.
918: 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
919: second will return a null terminated y
921: 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
923: Not for use in Fortran
925: Level: intermediate
928: .seealso: PetscTokenCreate(), PetscTokenDestroy()
929: @*/
930: PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
931: {
932: char *ptr = a->current,token;
935: *result = a->current;
936: if (ptr && !*ptr) {*result = NULL; return(0);}
937: token = a->token;
938: if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
939: while (ptr) {
940: if (*ptr == token) {
941: *ptr++ = 0;
942: while (*ptr == a->token) ptr++;
943: a->current = ptr;
944: break;
945: }
946: if (!*ptr) {
947: a->current = NULL;
948: break;
949: }
950: ptr++;
951: }
952: return(0);
953: }
955: /*@C
956: PetscTokenCreate - Creates a PetscToken used to find tokens in a string
958: Not Collective
960: Input Parameters:
961: + string - the string to look in
962: - b - the separator character
964: Output Parameter:
965: . t- the token object
967: Notes:
969: This version is different from the system version in that
970: it allows you to pass a read-only string into the function.
972: Not for use in Fortran
974: Level: intermediate
976: .seealso: PetscTokenFind(), PetscTokenDestroy()
977: @*/
978: PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
979: {
983: PetscNew(t);
984: PetscStrallocpy(a,&(*t)->array);
986: (*t)->current = (*t)->array;
987: (*t)->token = b;
988: return(0);
989: }
991: /*@C
992: PetscTokenDestroy - Destroys a PetscToken
994: Not Collective
996: Input Parameters:
997: . a - pointer to token
999: Level: intermediate
1001: Notes:
1002: Not for use in Fortran
1004: .seealso: PetscTokenCreate(), PetscTokenFind()
1005: @*/
1006: PetscErrorCode PetscTokenDestroy(PetscToken *a)
1007: {
1011: if (!*a) return(0);
1012: PetscFree((*a)->array);
1013: PetscFree(*a);
1014: return(0);
1015: }
1017: /*@C
1018: PetscStrInList - search string in character-delimited list
1020: Not Collective
1022: Input Parameters:
1023: + str - the string to look for
1024: . list - the list to search in
1025: - sep - the separator character
1027: Output Parameter:
1028: . found - whether str is in list
1030: Level: intermediate
1032: Notes:
1033: Not for use in Fortran
1035: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1036: @*/
1037: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1038: {
1039: PetscToken token;
1040: char *item;
1044: *found = PETSC_FALSE;
1045: PetscTokenCreate(list,sep,&token);
1046: PetscTokenFind(token,&item);
1047: while (item) {
1048: PetscStrcmp(str,item,found);
1049: if (*found) break;
1050: PetscTokenFind(token,&item);
1051: }
1052: PetscTokenDestroy(&token);
1053: return(0);
1054: }
1056: /*@C
1057: PetscGetPetscDir - Gets the directory PETSc is installed in
1059: Not Collective
1061: Output Parameter:
1062: . dir - the directory
1064: Level: developer
1066: Notes:
1067: Not for use in Fortran
1069: @*/
1070: PetscErrorCode PetscGetPetscDir(const char *dir[])
1071: {
1073: *dir = PETSC_DIR;
1074: return(0);
1075: }
1077: /*@C
1078: PetscStrreplace - Replaces substrings in string with other substrings
1080: Not Collective
1082: Input Parameters:
1083: + comm - MPI_Comm of processors that are processing the string
1084: . aa - the string to look in
1085: . b - the resulting copy of a with replaced strings (b can be the same as a)
1086: - len - the length of b
1088: Notes:
1089: Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1090: ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1091: as well as any environmental variables.
1093: PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1094: PETSc was built with and do not use environmental variables.
1096: Not for use in Fortran
1098: Level: intermediate
1100: @*/
1101: PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1102: {
1104: int i = 0;
1105: size_t l,l1,l2,l3;
1106: char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1107: const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
1108: char *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
1109: PetscBool flag;
1112: if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1113: if (aa == b) {
1114: PetscStrallocpy(aa,(char**)&a);
1115: }
1116: PetscMalloc1(len,&work);
1118: /* get values for replaced variables */
1119: PetscStrallocpy(PETSC_ARCH,&r[0]);
1120: PetscStrallocpy(PETSC_DIR,&r[1]);
1121: PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1122: PetscMalloc1(256,&r[3]);
1123: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1124: PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1125: PetscMalloc1(256,&r[6]);
1126: PetscMalloc1(256,&r[7]);
1127: PetscGetDisplay(r[3],256);
1128: PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1129: PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1130: PetscGetUserName(r[6],256);
1131: PetscGetHostName(r[7],256);
1133: /* replace that are in environment */
1134: PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1135: if (flag) {
1136: PetscFree(r[2]);
1137: PetscStrallocpy(env,&r[2]);
1138: }
1140: /* replace the requested strings */
1141: PetscStrncpy(b,a,len);
1142: while (s[i]) {
1143: PetscStrlen(s[i],&l);
1144: PetscStrstr(b,s[i],&par);
1145: while (par) {
1146: *par = 0;
1147: par += l;
1149: PetscStrlen(b,&l1);
1150: PetscStrlen(r[i],&l2);
1151: PetscStrlen(par,&l3);
1152: if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1153: PetscStrcpy(work,b);
1154: PetscStrcat(work,r[i]);
1155: PetscStrcat(work,par);
1156: PetscStrncpy(b,work,len);
1157: PetscStrstr(b,s[i],&par);
1158: }
1159: i++;
1160: }
1161: i = 0;
1162: while (r[i]) {
1163: tfree = (char*)r[i];
1164: PetscFree(tfree);
1165: i++;
1166: }
1168: /* look for any other ${xxx} strings to replace from environmental variables */
1169: PetscStrstr(b,"${",&par);
1170: while (par) {
1171: *par = 0;
1172: par += 2;
1173: PetscStrcpy(work,b);
1174: PetscStrstr(par,"}",&epar);
1175: *epar = 0;
1176: epar += 1;
1177: PetscOptionsGetenv(comm,par,env,256,&flag);
1178: if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1179: PetscStrcat(work,env);
1180: PetscStrcat(work,epar);
1181: PetscStrcpy(b,work);
1182: PetscStrstr(b,"${",&par);
1183: }
1184: PetscFree(work);
1185: if (aa == b) {
1186: PetscFree(a);
1187: }
1188: return(0);
1189: }
1191: /*@C
1192: PetscEListFind - searches list of strings for given string, using case insensitive matching
1194: Not Collective
1196: Input Parameters:
1197: + n - number of strings in
1198: . list - list of strings to search
1199: - str - string to look for, empty string "" accepts default (first entry in list)
1201: Output Parameters:
1202: + value - index of matching string (if found)
1203: - found - boolean indicating whether string was found (can be NULL)
1205: Notes:
1206: Not for use in Fortran
1208: Level: advanced
1209: @*/
1210: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1211: {
1213: PetscBool matched;
1214: PetscInt i;
1217: if (found) *found = PETSC_FALSE;
1218: for (i=0; i<n; i++) {
1219: PetscStrcasecmp(str,list[i],&matched);
1220: if (matched || !str[0]) {
1221: if (found) *found = PETSC_TRUE;
1222: *value = i;
1223: break;
1224: }
1225: }
1226: return(0);
1227: }
1229: /*@C
1230: PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1232: Not Collective
1234: Input Parameters:
1235: + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1236: - str - string to look for
1238: Output Parameters:
1239: + value - index of matching string (if found)
1240: - found - boolean indicating whether string was found (can be NULL)
1242: Notes:
1243: Not for use in Fortran
1245: Level: advanced
1246: @*/
1247: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1248: {
1250: PetscInt n = 0,evalue;
1251: PetscBool efound;
1254: 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");
1255: if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1256: n -= 3; /* drop enum name, prefix, and null termination */
1257: PetscEListFind(n,enumlist,str,&evalue,&efound);
1258: if (efound) *value = (PetscEnum)evalue;
1259: if (found) *found = efound;
1260: return(0);
1261: }