xref: /petsc/src/sys/utils/str.c (revision 6d70ba194318a0a11bb99f2be660ae94e5cb6b93)
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.
5 
6 */
7 #include <petscsys.h>                   /*I  "petscsys.h"   I*/
8 #if defined(PETSC_HAVE_STRINGS_H)
9 #  include <strings.h>          /* strcasecmp */
10 #endif
11 
12 /*@C
13    PetscStrToArray - Separates a string by a character (for example ' ' or '\n') and creates an array of strings
14 
15    Not Collective
16 
17    Input Parameters:
18 +  s - pointer to string
19 -  sp - separator character
20 
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
24 
25    Level: intermediate
26 
27    Notes:
28     this may be called before PetscInitialize() or after PetscFinalize()
29 
30    Not for use in Fortran
31 
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()
35 
36 .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
37 
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;
43 
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;
64 
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   }
73 
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;
85 
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 }
96 
97 /*@C
98    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
99 
100    Not Collective
101 
102    Output Parameters:
103 +  argc - the number of arguments
104 -  args - the array of arguments
105 
106    Level: intermediate
107 
108    Notes:
109     This may be called before PetscInitialize() or after PetscFinalize()
110 
111    Not for use in Fortran
112 
113 .seealso: PetscStrToArray()
114 
115 @*/
116 PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
117 {
118   PetscInt i;
119 
120   for (i=0; i<argc; i++) free(args[i]);
121   if (args) free(args);
122   return 0;
123 }
124 
125 /*@C
126    PetscStrlen - Gets length of a string
127 
128    Not Collective
129 
130    Input Parameters:
131 .  s - pointer to string
132 
133    Output Parameter:
134 .  len - length in bytes
135 
136    Level: intermediate
137 
138    Note:
139    This routine is analogous to strlen().
140 
141    Null string returns a length of zero
142 
143    Not for use in Fortran
144 
145 @*/
146 PetscErrorCode  PetscStrlen(const char s[],size_t *len)
147 {
148   PetscFunctionBegin;
149   if (!s) *len = 0;
150   else    *len = strlen(s);
151   PetscFunctionReturn(0);
152 }
153 
154 /*@C
155    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
156 
157    Not Collective
158 
159    Input Parameters:
160 .  s - pointer to string
161 
162    Output Parameter:
163 .  t - the copied string
164 
165    Level: intermediate
166 
167    Note:
168       Null string returns a new null string
169 
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.
174 
175 .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()
176 
177 @*/
178 PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
179 {
180   PetscErrorCode ierr;
181   size_t         len;
182   char           *tmp = NULL;
183 
184   PetscFunctionBegin;
185   if (s) {
186     ierr = PetscStrlen(s,&len);CHKERRQ(ierr);
187     ierr = PetscMalloc1(1+len,&tmp);CHKERRQ(ierr);
188     ierr = PetscStrcpy(tmp,s);CHKERRQ(ierr);
189   }
190   *t = tmp;
191   PetscFunctionReturn(0);
192 }
193 
194 /*@C
195    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
196 
197    Not Collective
198 
199    Input Parameters:
200 .  s - pointer to array of strings (final string is a null)
201 
202    Output Parameter:
203 .  t - the copied array string
204 
205    Level: intermediate
206 
207    Note:
208       Not for use in Fortran
209 
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()
214 
215 @*/
216 PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
217 {
218   PetscErrorCode ierr;
219   PetscInt       i,n = 0;
220 
221   PetscFunctionBegin;
222   while (list[n++]) ;
223   ierr = PetscMalloc1(n+1,t);CHKERRQ(ierr);
224   for (i=0; i<n; i++) {
225     ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr);
226   }
227   (*t)[n] = NULL;
228   PetscFunctionReturn(0);
229 }
230 
231 /*@C
232    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
233 
234    Not Collective
235 
236    Output Parameters:
237 .   list - array of strings
238 
239    Level: intermediate
240 
241    Notes:
242     Not for use in Fortran
243 
244 .seealso: PetscStrArrayallocpy()
245 
246 @*/
247 PetscErrorCode PetscStrArrayDestroy(char ***list)
248 {
249   PetscInt       n = 0;
250   PetscErrorCode ierr;
251 
252   PetscFunctionBegin;
253   if (!*list) PetscFunctionReturn(0);
254   while ((*list)[n]) {
255     ierr = PetscFree((*list)[n]);CHKERRQ(ierr);
256     n++;
257   }
258   ierr = PetscFree(*list);CHKERRQ(ierr);
259   PetscFunctionReturn(0);
260 }
261 
262 /*@C
263    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
264 
265    Not Collective
266 
267    Input Parameters:
268 +  n - the number of string entries
269 -  s - pointer to array of strings
270 
271    Output Parameter:
272 .  t - the copied array string
273 
274    Level: intermediate
275 
276    Note:
277       Not for use in Fortran
278 
279 .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()
280 
281 @*/
282 PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
283 {
284   PetscErrorCode ierr;
285   PetscInt       i;
286 
287   PetscFunctionBegin;
288   ierr = PetscMalloc1(n,t);CHKERRQ(ierr);
289   for (i=0; i<n; i++) {
290     ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr);
291   }
292   PetscFunctionReturn(0);
293 }
294 
295 /*@C
296    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
297 
298    Not Collective
299 
300    Output Parameters:
301 +   n - number of string entries
302 -   list - array of strings
303 
304    Level: intermediate
305 
306    Notes:
307     Not for use in Fortran
308 
309 .seealso: PetscStrArrayallocpy()
310 
311 @*/
312 PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
313 {
314   PetscErrorCode ierr;
315   PetscInt       i;
316 
317   PetscFunctionBegin;
318   if (!*list) PetscFunctionReturn(0);
319   for (i=0; i<n; i++) {
320     ierr = PetscFree((*list)[i]);CHKERRQ(ierr);
321   }
322   ierr = PetscFree(*list);CHKERRQ(ierr);
323   PetscFunctionReturn(0);
324 }
325 
326 /*@C
327    PetscStrcpy - Copies a string
328 
329    Not Collective
330 
331    Input Parameters:
332 .  t - pointer to string
333 
334    Output Parameter:
335 .  s - the copied string
336 
337    Level: intermediate
338 
339    Notes:
340      Null string returns a string starting with zero
341 
342      Not for use in Fortran
343 
344      It is recommended you use PetscStrncpy() instead of this routine
345 
346 .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
347 
348 @*/
349 
350 PetscErrorCode  PetscStrcpy(char s[],const char t[])
351 {
352   PetscFunctionBegin;
353   PetscCheckFalse(t && !s,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   PetscFunctionReturn(0);
357 }
358 
359 /*@C
360    PetscStrncpy - Copies a string up to a certain length
361 
362    Not Collective
363 
364    Input Parameters:
365 +  t - pointer to string
366 -  n - the length to copy
367 
368    Output Parameter:
369 .  s - the copied string
370 
371    Level: intermediate
372 
373    Note:
374      Null string returns a string starting with zero
375 
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.
379 
380   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
381 
382 .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
383 
384 @*/
385 PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
386 {
387   PetscFunctionBegin;
388   PetscCheckFalse(t && !s,PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
389   PetscCheckFalse(s && !n,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   PetscFunctionReturn(0);
399 }
400 
401 /*@C
402    PetscStrcat - Concatenates a string onto a given string
403 
404    Not Collective
405 
406    Input Parameters:
407 +  s - string to be added to
408 -  t - pointer to string to be added to end
409 
410    Level: intermediate
411 
412    Notes:
413     Not for use in Fortran
414 
415     It is recommended you use PetscStrlcat() instead of this routine
416 
417 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
418 
419 @*/
420 PetscErrorCode  PetscStrcat(char s[],const char t[])
421 {
422   PetscFunctionBegin;
423   if (!t) PetscFunctionReturn(0);
424   strcat(s,t);
425   PetscFunctionReturn(0);
426 }
427 
428 /*@C
429    PetscStrlcat - Concatenates a string onto a given string, up to a given length
430 
431    Not Collective
432 
433    Input Parameters:
434 +  s - pointer to string to be added to at end
435 .  t - string to be added
436 -  n - length of the original allocated string
437 
438    Level: intermediate
439 
440   Notes:
441   Not for use in Fortran
442 
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().
446 
447 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
448 
449 @*/
450 PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
451 {
452   size_t         len;
453   PetscErrorCode ierr;
454 
455   PetscFunctionBegin;
456   PetscCheckFalse(t && !n,PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
457   if (!t) PetscFunctionReturn(0);
458   ierr = PetscStrlen(t,&len);CHKERRQ(ierr);
459   strncat(s,t,n - len);
460   s[n-1] = 0;
461   PetscFunctionReturn(0);
462 }
463 
464 void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
465 {
466   int c;
467 
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 }
476 
477 /*@C
478    PetscStrcmp - Compares two strings,
479 
480    Not Collective
481 
482    Input Parameters:
483 +  a - pointer to string first string
484 -  b - pointer to second string
485 
486    Output Parameter:
487 .  flg - PETSC_TRUE if the two strings are equal
488 
489    Level: intermediate
490 
491    Notes:
492     Not for use in Fortran
493 
494 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
495 @*/
496 PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool *flg)
497 {
498   PetscFunctionBegin;
499   if (!a && !b)      *flg = PETSC_TRUE;
500   else if (!a || !b) *flg = PETSC_FALSE;
501   else               *flg = (PetscBool)!strcmp(a,b);
502   PetscFunctionReturn(0);
503 }
504 
505 /*@C
506    PetscStrgrt - If first string is greater than the second
507 
508    Not Collective
509 
510    Input Parameters:
511 +  a - pointer to first string
512 -  b - pointer to second string
513 
514    Output Parameter:
515 .  flg - if the first string is greater
516 
517    Notes:
518     Null arguments are ok, a null string is considered smaller than
519     all others
520 
521    Not for use in Fortran
522 
523    Level: intermediate
524 
525 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
526 
527 @*/
528 PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
529 {
530   int c;
531 
532   PetscFunctionBegin;
533   if (!a && !b) *t = PETSC_FALSE;
534   else if (a && !b) *t = PETSC_TRUE;
535   else if (!a && b) *t = PETSC_FALSE;
536   else {
537     c = strcmp(a,b);
538     if (c > 0) *t = PETSC_TRUE;
539     else       *t = PETSC_FALSE;
540   }
541   PetscFunctionReturn(0);
542 }
543 
544 /*@C
545    PetscStrcasecmp - Returns true if the two strings are the same
546      except possibly for case.
547 
548    Not Collective
549 
550    Input Parameters:
551 +  a - pointer to first string
552 -  b - pointer to second string
553 
554    Output Parameter:
555 .  flg - if the two strings are the same
556 
557    Notes:
558     Null arguments are ok
559 
560    Not for use in Fortran
561 
562    Level: intermediate
563 
564 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
565 
566 @*/
567 PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
568 {
569   int c;
570 
571   PetscFunctionBegin;
572   if (!a && !b) c = 0;
573   else if (!a || !b) c = 1;
574 #if defined(PETSC_HAVE_STRCASECMP)
575   else c = strcasecmp(a,b);
576 #elif defined(PETSC_HAVE_STRICMP)
577   else c = stricmp(a,b);
578 #else
579   else {
580     char           *aa,*bb;
581     PetscErrorCode ierr;
582     ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr);
583     ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr);
584     ierr = PetscStrtolower(aa);CHKERRQ(ierr);
585     ierr = PetscStrtolower(bb);CHKERRQ(ierr);
586     ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr);
587     ierr = PetscFree(aa);CHKERRQ(ierr);
588     ierr = PetscFree(bb);CHKERRQ(ierr);
589     PetscFunctionReturn(0);
590   }
591 #endif
592   if (!c) *t = PETSC_TRUE;
593   else    *t = PETSC_FALSE;
594   PetscFunctionReturn(0);
595 }
596 
597 /*@C
598    PetscStrncmp - Compares two strings, up to a certain length
599 
600    Not Collective
601 
602    Input Parameters:
603 +  a - pointer to first string
604 .  b - pointer to second string
605 -  n - length to compare up to
606 
607    Output Parameter:
608 .  t - if the two strings are equal
609 
610    Level: intermediate
611 
612    Notes:
613     Not for use in Fortran
614 
615 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
616 
617 @*/
618 PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
619 {
620   int c;
621 
622   PetscFunctionBegin;
623   c = strncmp(a,b,n);
624   if (!c) *t = PETSC_TRUE;
625   else    *t = PETSC_FALSE;
626   PetscFunctionReturn(0);
627 }
628 
629 /*@C
630    PetscStrchr - Locates first occurrence of a character in a string
631 
632    Not Collective
633 
634    Input Parameters:
635 +  a - pointer to string
636 -  b - character
637 
638    Output Parameter:
639 .  c - location of occurrence, NULL if not found
640 
641    Level: intermediate
642 
643    Notes:
644     Not for use in Fortran
645 
646 @*/
647 PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
648 {
649   PetscFunctionBegin;
650   *c = (char*)strchr(a,b);
651   PetscFunctionReturn(0);
652 }
653 
654 /*@C
655    PetscStrrchr - Locates one location past the last occurrence of a character in a string,
656       if the character is not found then returns entire string
657 
658    Not Collective
659 
660    Input Parameters:
661 +  a - pointer to string
662 -  b - character
663 
664    Output Parameter:
665 .  tmp - location of occurrence, a if not found
666 
667    Level: intermediate
668 
669    Notes:
670     Not for use in Fortran
671 
672 @*/
673 PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
674 {
675   PetscFunctionBegin;
676   *tmp = (char*)strrchr(a,b);
677   if (!*tmp) *tmp = (char*)a;
678   else *tmp = *tmp + 1;
679   PetscFunctionReturn(0);
680 }
681 
682 /*@C
683    PetscStrtolower - Converts string to lower case
684 
685    Not Collective
686 
687    Input Parameters:
688 .  a - pointer to string
689 
690    Level: intermediate
691 
692    Notes:
693     Not for use in Fortran
694 
695 @*/
696 PetscErrorCode  PetscStrtolower(char a[])
697 {
698   PetscFunctionBegin;
699   while (*a) {
700     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
701     a++;
702   }
703   PetscFunctionReturn(0);
704 }
705 
706 /*@C
707    PetscStrtoupper - Converts string to upper case
708 
709    Not Collective
710 
711    Input Parameters:
712 .  a - pointer to string
713 
714    Level: intermediate
715 
716    Notes:
717     Not for use in Fortran
718 
719 @*/
720 PetscErrorCode  PetscStrtoupper(char a[])
721 {
722   PetscFunctionBegin;
723   while (*a) {
724     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
725     a++;
726   }
727   PetscFunctionReturn(0);
728 }
729 
730 /*@C
731    PetscStrendswith - Determines if a string ends with a certain string
732 
733    Not Collective
734 
735    Input Parameters:
736 +  a - pointer to string
737 -  b - string to endwith
738 
739    Output Parameter:
740 .  flg - PETSC_TRUE or PETSC_FALSE
741 
742    Notes:
743     Not for use in Fortran
744 
745    Level: intermediate
746 
747 @*/
748 PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
749 {
750   char           *test;
751   PetscErrorCode ierr;
752   size_t         na,nb;
753 
754   PetscFunctionBegin;
755   *flg = PETSC_FALSE;
756   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
757   if (test) {
758     ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
759     ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
760     if (a+na-nb == test) *flg = PETSC_TRUE;
761   }
762   PetscFunctionReturn(0);
763 }
764 
765 /*@C
766    PetscStrbeginswith - Determines if a string begins with a certain string
767 
768    Not Collective
769 
770    Input Parameters:
771 +  a - pointer to string
772 -  b - string to begin with
773 
774    Output Parameter:
775 .  flg - PETSC_TRUE or PETSC_FALSE
776 
777    Notes:
778     Not for use in Fortran
779 
780    Level: intermediate
781 
782 .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
783           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
784 
785 @*/
786 PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
787 {
788   char           *test;
789   PetscErrorCode ierr;
790 
791   PetscFunctionBegin;
792   *flg = PETSC_FALSE;
793   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
794   if (test && (test == a)) *flg = PETSC_TRUE;
795   PetscFunctionReturn(0);
796 }
797 
798 /*@C
799    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
800 
801    Not Collective
802 
803    Input Parameters:
804 +  a - pointer to string
805 -  bs - strings to end with (last entry must be NULL)
806 
807    Output Parameter:
808 .  cnt - the index of the string it ends with or the index of NULL
809 
810    Notes:
811     Not for use in Fortran
812 
813    Level: intermediate
814 
815 @*/
816 PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
817 {
818   PetscBool      flg;
819   PetscErrorCode ierr;
820 
821   PetscFunctionBegin;
822   *cnt = 0;
823   while (bs[*cnt]) {
824     ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
825     if (flg) PetscFunctionReturn(0);
826     *cnt += 1;
827   }
828   PetscFunctionReturn(0);
829 }
830 
831 /*@C
832    PetscStrrstr - Locates last occurrence of string in another string
833 
834    Not Collective
835 
836    Input Parameters:
837 +  a - pointer to string
838 -  b - string to find
839 
840    Output Parameter:
841 .  tmp - location of occurrence
842 
843    Notes:
844     Not for use in Fortran
845 
846    Level: intermediate
847 
848 @*/
849 PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
850 {
851   const char *stmp = a, *ltmp = NULL;
852 
853   PetscFunctionBegin;
854   while (stmp) {
855     stmp = (char*)strstr(stmp,b);
856     if (stmp) {ltmp = stmp;stmp++;}
857   }
858   *tmp = (char*)ltmp;
859   PetscFunctionReturn(0);
860 }
861 
862 /*@C
863    PetscStrstr - Locates first occurrence of string in another string
864 
865    Not Collective
866 
867    Input Parameters:
868 +  haystack - string to search
869 -  needle - string to find
870 
871    Output Parameter:
872 .  tmp - location of occurrence, is a NULL if the string is not found
873 
874    Notes:
875     Not for use in Fortran
876 
877    Level: intermediate
878 
879 @*/
880 PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
881 {
882   PetscFunctionBegin;
883   *tmp = (char*)strstr(haystack,needle);
884   PetscFunctionReturn(0);
885 }
886 
887 struct _p_PetscToken {char token;char *array;char *current;};
888 
889 /*@C
890    PetscTokenFind - Locates next "token" in a string
891 
892    Not Collective
893 
894    Input Parameters:
895 .  a - pointer to token
896 
897    Output Parameter:
898 .  result - location of occurrence, NULL if not found
899 
900    Notes:
901 
902      This version is different from the system version in that
903   it allows you to pass a read-only string into the function.
904 
905      This version also treats all characters etc. inside a double quote "
906    as a single token.
907 
908      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
909    second will return a null terminated y
910 
911      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
912 
913     Not for use in Fortran
914 
915    Level: intermediate
916 
917 .seealso: PetscTokenCreate(), PetscTokenDestroy()
918 @*/
919 PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
920 {
921   char *ptr = a->current,token;
922 
923   PetscFunctionBegin;
924   *result = a->current;
925   if (ptr && !*ptr) {*result = NULL; PetscFunctionReturn(0);}
926   token = a->token;
927   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
928   while (ptr) {
929     if (*ptr == token) {
930       *ptr++ = 0;
931       while (*ptr == a->token) ptr++;
932       a->current = ptr;
933       break;
934     }
935     if (!*ptr) {
936       a->current = NULL;
937       break;
938     }
939     ptr++;
940   }
941   PetscFunctionReturn(0);
942 }
943 
944 /*@C
945    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
946 
947    Not Collective
948 
949    Input Parameters:
950 +  string - the string to look in
951 -  b - the separator character
952 
953    Output Parameter:
954 .  t- the token object
955 
956    Notes:
957 
958      This version is different from the system version in that
959   it allows you to pass a read-only string into the function.
960 
961     Not for use in Fortran
962 
963    Level: intermediate
964 
965 .seealso: PetscTokenFind(), PetscTokenDestroy()
966 @*/
967 PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
968 {
969   PetscErrorCode ierr;
970 
971   PetscFunctionBegin;
972   ierr = PetscNew(t);CHKERRQ(ierr);
973   ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
974 
975   (*t)->current = (*t)->array;
976   (*t)->token   = b;
977   PetscFunctionReturn(0);
978 }
979 
980 /*@C
981    PetscTokenDestroy - Destroys a PetscToken
982 
983    Not Collective
984 
985    Input Parameters:
986 .  a - pointer to token
987 
988    Level: intermediate
989 
990    Notes:
991     Not for use in Fortran
992 
993 .seealso: PetscTokenCreate(), PetscTokenFind()
994 @*/
995 PetscErrorCode  PetscTokenDestroy(PetscToken *a)
996 {
997   PetscErrorCode ierr;
998 
999   PetscFunctionBegin;
1000   if (!*a) PetscFunctionReturn(0);
1001   ierr = PetscFree((*a)->array);CHKERRQ(ierr);
1002   ierr = PetscFree(*a);CHKERRQ(ierr);
1003   PetscFunctionReturn(0);
1004 }
1005 
1006 /*@C
1007    PetscStrInList - search string in character-delimited list
1008 
1009    Not Collective
1010 
1011    Input Parameters:
1012 +  str - the string to look for
1013 .  list - the list to search in
1014 -  sep - the separator character
1015 
1016    Output Parameter:
1017 .  found - whether str is in list
1018 
1019    Level: intermediate
1020 
1021    Notes:
1022     Not for use in Fortran
1023 
1024 .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1025 @*/
1026 PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1027 {
1028   PetscToken     token;
1029   char           *item;
1030   PetscErrorCode ierr;
1031 
1032   PetscFunctionBegin;
1033   *found = PETSC_FALSE;
1034   ierr = PetscTokenCreate(list,sep,&token);CHKERRQ(ierr);
1035   ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1036   while (item) {
1037     ierr = PetscStrcmp(str,item,found);CHKERRQ(ierr);
1038     if (*found) break;
1039     ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1040   }
1041   ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
1042   PetscFunctionReturn(0);
1043 }
1044 
1045 /*@C
1046    PetscGetPetscDir - Gets the directory PETSc is installed in
1047 
1048    Not Collective
1049 
1050    Output Parameter:
1051 .  dir - the directory
1052 
1053    Level: developer
1054 
1055    Notes:
1056     Not for use in Fortran
1057 
1058 @*/
1059 PetscErrorCode  PetscGetPetscDir(const char *dir[])
1060 {
1061   PetscFunctionBegin;
1062   *dir = PETSC_DIR;
1063   PetscFunctionReturn(0);
1064 }
1065 
1066 /*@C
1067    PetscStrreplace - Replaces substrings in string with other substrings
1068 
1069    Not Collective
1070 
1071    Input Parameters:
1072 +   comm - MPI_Comm of processors that are processing the string
1073 .   aa - the string to look in
1074 .   b - the resulting copy of a with replaced strings (b can be the same as a)
1075 -   len - the length of b
1076 
1077    Notes:
1078       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1079       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1080       as well as any environmental variables.
1081 
1082       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1083       PETSc was built with and do not use environmental variables.
1084 
1085       Not for use in Fortran
1086 
1087    Level: intermediate
1088 
1089 @*/
1090 PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1091 {
1092   PetscErrorCode ierr;
1093   int            i = 0;
1094   size_t         l,l1,l2,l3;
1095   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1096   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
1097   char           *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
1098   PetscBool      flag;
1099   static size_t  DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;
1100 
1101   PetscFunctionBegin;
1102   PetscCheckFalse(!a || !b,PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1103   if (aa == b) {
1104     ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr);
1105   }
1106   ierr = PetscMalloc1(len,&work);CHKERRQ(ierr);
1107 
1108   /* get values for replaced variables */
1109   ierr = PetscStrallocpy(PETSC_ARCH,&r[0]);CHKERRQ(ierr);
1110   ierr = PetscStrallocpy(PETSC_DIR,&r[1]);CHKERRQ(ierr);
1111   ierr = PetscStrallocpy(PETSC_LIB_DIR,&r[2]);CHKERRQ(ierr);
1112   ierr = PetscMalloc1(DISPLAY_LENGTH,&r[3]);CHKERRQ(ierr);
1113   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr);
1114   ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr);
1115   ierr = PetscMalloc1(USER_LENGTH,&r[6]);CHKERRQ(ierr);
1116   ierr = PetscMalloc1(HOST_LENGTH,&r[7]);CHKERRQ(ierr);
1117   ierr = PetscGetDisplay(r[3],DISPLAY_LENGTH);CHKERRQ(ierr);
1118   ierr = PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1119   ierr = PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1120   ierr = PetscGetUserName(r[6],USER_LENGTH);CHKERRQ(ierr);
1121   ierr = PetscGetHostName(r[7],HOST_LENGTH);CHKERRQ(ierr);
1122 
1123   /* replace that are in environment */
1124   ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);CHKERRQ(ierr);
1125   if (flag) {
1126     ierr = PetscFree(r[2]);CHKERRQ(ierr);
1127     ierr = PetscStrallocpy(env,&r[2]);CHKERRQ(ierr);
1128   }
1129 
1130   /* replace the requested strings */
1131   ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
1132   while (s[i]) {
1133     ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
1134     ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1135     while (par) {
1136       *par =  0;
1137       par += l;
1138 
1139       ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
1140       ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
1141       ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
1142       PetscCheckFalse(l1 + l2 + l3 >= len,PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1143       ierr = PetscStrncpy(work,b,len);CHKERRQ(ierr);
1144       ierr = PetscStrlcat(work,r[i],len);CHKERRQ(ierr);
1145       ierr = PetscStrlcat(work,par,len);CHKERRQ(ierr);
1146       ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1147       ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1148     }
1149     i++;
1150   }
1151   i = 0;
1152   while (r[i]) {
1153     tfree = (char*)r[i];
1154     ierr  = PetscFree(tfree);CHKERRQ(ierr);
1155     i++;
1156   }
1157 
1158   /* look for any other ${xxx} strings to replace from environmental variables */
1159   ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1160   while (par) {
1161     *par  = 0;
1162     par  += 2;
1163     ierr  = PetscStrncpy(work,b,len);CHKERRQ(ierr);
1164     ierr  = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
1165     *epar = 0;
1166     epar += 1;
1167     ierr  = PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);CHKERRQ(ierr);
1168     PetscCheckFalse(!flag,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1169     ierr = PetscStrlcat(work,env,len);CHKERRQ(ierr);
1170     ierr = PetscStrlcat(work,epar,len);CHKERRQ(ierr);
1171     ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1172     ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1173   }
1174   ierr = PetscFree(work);CHKERRQ(ierr);
1175   if (aa == b) {
1176     ierr = PetscFree(a);CHKERRQ(ierr);
1177   }
1178   PetscFunctionReturn(0);
1179 }
1180 
1181 /*@C
1182    PetscEListFind - searches list of strings for given string, using case insensitive matching
1183 
1184    Not Collective
1185 
1186    Input Parameters:
1187 +  n - number of strings in
1188 .  list - list of strings to search
1189 -  str - string to look for, empty string "" accepts default (first entry in list)
1190 
1191    Output Parameters:
1192 +  value - index of matching string (if found)
1193 -  found - boolean indicating whether string was found (can be NULL)
1194 
1195    Notes:
1196    Not for use in Fortran
1197 
1198    Level: advanced
1199 @*/
1200 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1201 {
1202   PetscErrorCode ierr;
1203   PetscBool matched;
1204   PetscInt i;
1205 
1206   PetscFunctionBegin;
1207   if (found) *found = PETSC_FALSE;
1208   for (i=0; i<n; i++) {
1209     ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr);
1210     if (matched || !str[0]) {
1211       if (found) *found = PETSC_TRUE;
1212       *value = i;
1213       break;
1214     }
1215   }
1216   PetscFunctionReturn(0);
1217 }
1218 
1219 /*@C
1220    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1221 
1222    Not Collective
1223 
1224    Input Parameters:
1225 +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1226 -  str - string to look for
1227 
1228    Output Parameters:
1229 +  value - index of matching string (if found)
1230 -  found - boolean indicating whether string was found (can be NULL)
1231 
1232    Notes:
1233    Not for use in Fortran
1234 
1235    Level: advanced
1236 @*/
1237 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1238 {
1239   PetscErrorCode ierr;
1240   PetscInt n = 0,evalue;
1241   PetscBool efound;
1242 
1243   PetscFunctionBegin;
1244   while (enumlist[n++]) PetscCheckFalse(n > 50,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1245   PetscCheckFalse(n < 3,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1246   n -= 3; /* drop enum name, prefix, and null termination */
1247   ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr);
1248   if (efound) *value = (PetscEnum)evalue;
1249   if (found) *found = efound;
1250   PetscFunctionReturn(0);
1251 }
1252