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 Parameter:
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 @*/
PetscStrToArray(const char s[],char sp,int * argc,char *** args)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 @*/
PetscStrToArrayDestroy(int argc,char ** args)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 @*/
PetscStrlen(const char s[],size_t * len)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 @*/
PetscStrallocpy(const char s[],char * t[])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 @*/
PetscStrArrayallocpy(const char * const * list,char *** t)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 @*/
PetscStrArrayDestroy(char *** list)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 @*/
PetscStrNArrayallocpy(PetscInt n,const char * const * list,char *** t)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 @*/
PetscStrNArrayDestroy(PetscInt n,char *** list)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
PetscStrcpy(char s[],const char t[])350 PetscErrorCode PetscStrcpy(char s[],const char t[])
351 {
352 PetscFunctionBegin;
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 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 @*/
PetscStrncpy(char s[],const char t[],size_t n)385 PetscErrorCode PetscStrncpy(char s[],const char t[],size_t n)
386 {
387 PetscFunctionBegin;
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 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 @*/
PetscStrcat(char s[],const char t[])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 to
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 @*/
PetscStrlcat(char s[],const char t[],size_t n)450 PetscErrorCode PetscStrlcat(char s[],const char t[],size_t n)
451 {
452 size_t len;
453 PetscErrorCode ierr;
454
455 PetscFunctionBegin;
456 if (t && !n) SETERRQ(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
PetscStrcmpNoError(const char a[],const char b[],PetscBool * flg)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 @*/
PetscStrcmp(const char a[],const char b[],PetscBool * flg)497 PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg)
498 {
499 int c;
500
501 PetscFunctionBegin;
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 PetscFunctionReturn(0);
510 }
511
512 /*@C
513 PetscStrgrt - If first string is greater than the second
514
515 Not Collective
516
517 Input Parameters:
518 + a - pointer to first string
519 - b - pointer to second string
520
521 Output Parameter:
522 . flg - if the first string is greater
523
524 Notes:
525 Null arguments are ok, a null string is considered smaller than
526 all others
527
528 Not for use in Fortran
529
530 Level: intermediate
531
532 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
533
534 @*/
PetscStrgrt(const char a[],const char b[],PetscBool * t)535 PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t)
536 {
537 int c;
538
539 PetscFunctionBegin;
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 PetscFunctionReturn(0);
549 }
550
551 /*@C
552 PetscStrcasecmp - Returns true if the two strings are the same
553 except possibly for case.
554
555 Not Collective
556
557 Input Parameters:
558 + a - pointer to first string
559 - b - pointer to second string
560
561 Output Parameter:
562 . flg - if the two strings are the same
563
564 Notes:
565 Null arguments are ok
566
567 Not for use in Fortran
568
569 Level: intermediate
570
571 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
572
573 @*/
PetscStrcasecmp(const char a[],const char b[],PetscBool * t)574 PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t)
575 {
576 int c;
577
578 PetscFunctionBegin;
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;
588 PetscErrorCode ierr;
589 ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr);
590 ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr);
591 ierr = PetscStrtolower(aa);CHKERRQ(ierr);
592 ierr = PetscStrtolower(bb);CHKERRQ(ierr);
593 ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr);
594 ierr = PetscFree(aa);CHKERRQ(ierr);
595 ierr = PetscFree(bb);CHKERRQ(ierr);
596 PetscFunctionReturn(0);
597 }
598 #endif
599 if (!c) *t = PETSC_TRUE;
600 else *t = PETSC_FALSE;
601 PetscFunctionReturn(0);
602 }
603
604
605
606 /*@C
607 PetscStrncmp - Compares two strings, up to a certain length
608
609 Not Collective
610
611 Input Parameters:
612 + a - pointer to first string
613 . b - pointer to second string
614 - n - length to compare up to
615
616 Output Parameter:
617 . t - if the two strings are equal
618
619 Level: intermediate
620
621 Notes:
622 Not for use in Fortran
623
624 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
625
626 @*/
PetscStrncmp(const char a[],const char b[],size_t n,PetscBool * t)627 PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t)
628 {
629 int c;
630
631 PetscFunctionBegin;
632 c = strncmp(a,b,n);
633 if (!c) *t = PETSC_TRUE;
634 else *t = PETSC_FALSE;
635 PetscFunctionReturn(0);
636 }
637
638 /*@C
639 PetscStrchr - Locates first occurance of a character in a string
640
641 Not Collective
642
643 Input Parameters:
644 + a - pointer to string
645 - b - character
646
647 Output Parameter:
648 . c - location of occurance, NULL if not found
649
650 Level: intermediate
651
652 Notes:
653 Not for use in Fortran
654
655 @*/
PetscStrchr(const char a[],char b,char * c[])656 PetscErrorCode PetscStrchr(const char a[],char b,char *c[])
657 {
658 PetscFunctionBegin;
659 *c = (char*)strchr(a,b);
660 PetscFunctionReturn(0);
661 }
662
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
666
667 Not Collective
668
669 Input Parameters:
670 + a - pointer to string
671 - b - character
672
673 Output Parameter:
674 . tmp - location of occurance, a if not found
675
676 Level: intermediate
677
678 Notes:
679 Not for use in Fortran
680
681 @*/
PetscStrrchr(const char a[],char b,char * tmp[])682 PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[])
683 {
684 PetscFunctionBegin;
685 *tmp = (char*)strrchr(a,b);
686 if (!*tmp) *tmp = (char*)a;
687 else *tmp = *tmp + 1;
688 PetscFunctionReturn(0);
689 }
690
691 /*@C
692 PetscStrtolower - Converts string to lower case
693
694 Not Collective
695
696 Input Parameters:
697 . a - pointer to string
698
699 Level: intermediate
700
701 Notes:
702 Not for use in Fortran
703
704 @*/
PetscStrtolower(char a[])705 PetscErrorCode PetscStrtolower(char a[])
706 {
707 PetscFunctionBegin;
708 while (*a) {
709 if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
710 a++;
711 }
712 PetscFunctionReturn(0);
713 }
714
715 /*@C
716 PetscStrtoupper - Converts string to upper case
717
718 Not Collective
719
720 Input Parameters:
721 . a - pointer to string
722
723 Level: intermediate
724
725 Notes:
726 Not for use in Fortran
727
728 @*/
PetscStrtoupper(char a[])729 PetscErrorCode PetscStrtoupper(char a[])
730 {
731 PetscFunctionBegin;
732 while (*a) {
733 if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
734 a++;
735 }
736 PetscFunctionReturn(0);
737 }
738
739 /*@C
740 PetscStrendswith - Determines if a string ends with a certain string
741
742 Not Collective
743
744 Input Parameters:
745 + a - pointer to string
746 - b - string to endwith
747
748 Output Parameter:
749 . flg - PETSC_TRUE or PETSC_FALSE
750
751 Notes:
752 Not for use in Fortran
753
754 Level: intermediate
755
756 @*/
PetscStrendswith(const char a[],const char b[],PetscBool * flg)757 PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg)
758 {
759 char *test;
760 PetscErrorCode ierr;
761 size_t na,nb;
762
763 PetscFunctionBegin;
764 *flg = PETSC_FALSE;
765 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
766 if (test) {
767 ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
768 ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
769 if (a+na-nb == test) *flg = PETSC_TRUE;
770 }
771 PetscFunctionReturn(0);
772 }
773
774 /*@C
775 PetscStrbeginswith - Determines if a string begins with a certain string
776
777 Not Collective
778
779 Input Parameters:
780 + a - pointer to string
781 - b - string to begin with
782
783 Output Parameter:
784 . flg - PETSC_TRUE or PETSC_FALSE
785
786 Notes:
787 Not for use in Fortran
788
789 Level: intermediate
790
791 .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
792 PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
793
794 @*/
PetscStrbeginswith(const char a[],const char b[],PetscBool * flg)795 PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
796 {
797 char *test;
798 PetscErrorCode ierr;
799
800 PetscFunctionBegin;
801 *flg = PETSC_FALSE;
802 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
803 if (test && (test == a)) *flg = PETSC_TRUE;
804 PetscFunctionReturn(0);
805 }
806
807
808 /*@C
809 PetscStrendswithwhich - Determines if a string ends with one of several possible strings
810
811 Not Collective
812
813 Input Parameters:
814 + a - pointer to string
815 - bs - strings to end with (last entry must be NULL)
816
817 Output Parameter:
818 . cnt - the index of the string it ends with or the index of NULL
819
820 Notes:
821 Not for use in Fortran
822
823 Level: intermediate
824
825 @*/
PetscStrendswithwhich(const char a[],const char * const * bs,PetscInt * cnt)826 PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
827 {
828 PetscBool flg;
829 PetscErrorCode ierr;
830
831 PetscFunctionBegin;
832 *cnt = 0;
833 while (bs[*cnt]) {
834 ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
835 if (flg) PetscFunctionReturn(0);
836 *cnt += 1;
837 }
838 PetscFunctionReturn(0);
839 }
840
841 /*@C
842 PetscStrrstr - Locates last occurance of string in another string
843
844 Not Collective
845
846 Input Parameters:
847 + a - pointer to string
848 - b - string to find
849
850 Output Parameter:
851 . tmp - location of occurance
852
853 Notes:
854 Not for use in Fortran
855
856 Level: intermediate
857
858 @*/
PetscStrrstr(const char a[],const char b[],char * tmp[])859 PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[])
860 {
861 const char *stmp = a, *ltmp = NULL;
862
863 PetscFunctionBegin;
864 while (stmp) {
865 stmp = (char*)strstr(stmp,b);
866 if (stmp) {ltmp = stmp;stmp++;}
867 }
868 *tmp = (char*)ltmp;
869 PetscFunctionReturn(0);
870 }
871
872 /*@C
873 PetscStrstr - Locates first occurance of string in another string
874
875 Not Collective
876
877 Input Parameters:
878 + haystack - string to search
879 - needle - string to find
880
881 Output Parameter:
882 . tmp - location of occurance, is a NULL if the string is not found
883
884 Notes:
885 Not for use in Fortran
886
887 Level: intermediate
888
889 @*/
PetscStrstr(const char haystack[],const char needle[],char * tmp[])890 PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[])
891 {
892 PetscFunctionBegin;
893 *tmp = (char*)strstr(haystack,needle);
894 PetscFunctionReturn(0);
895 }
896
897 struct _p_PetscToken {char token;char *array;char *current;};
898
899 /*@C
900 PetscTokenFind - Locates next "token" in a string
901
902 Not Collective
903
904 Input Parameters:
905 . a - pointer to token
906
907 Output Parameter:
908 . result - location of occurance, NULL if not found
909
910 Notes:
911
912 This version is different from the system version in that
913 it allows you to pass a read-only string into the function.
914
915 This version also treats all characters etc. inside a double quote "
916 as a single token.
917
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
920
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
922
923 Not for use in Fortran
924
925 Level: intermediate
926
927
928 .seealso: PetscTokenCreate(), PetscTokenDestroy()
929 @*/
PetscTokenFind(PetscToken a,char * result[])930 PetscErrorCode PetscTokenFind(PetscToken a,char *result[])
931 {
932 char *ptr = a->current,token;
933
934 PetscFunctionBegin;
935 *result = a->current;
936 if (ptr && !*ptr) {*result = NULL; PetscFunctionReturn(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 PetscFunctionReturn(0);
953 }
954
955 /*@C
956 PetscTokenCreate - Creates a PetscToken used to find tokens in a string
957
958 Not Collective
959
960 Input Parameters:
961 + string - the string to look in
962 - b - the separator character
963
964 Output Parameter:
965 . t- the token object
966
967 Notes:
968
969 This version is different from the system version in that
970 it allows you to pass a read-only string into the function.
971
972 Not for use in Fortran
973
974 Level: intermediate
975
976 .seealso: PetscTokenFind(), PetscTokenDestroy()
977 @*/
PetscTokenCreate(const char a[],const char b,PetscToken * t)978 PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t)
979 {
980 PetscErrorCode ierr;
981
982 PetscFunctionBegin;
983 ierr = PetscNew(t);CHKERRQ(ierr);
984 ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
985
986 (*t)->current = (*t)->array;
987 (*t)->token = b;
988 PetscFunctionReturn(0);
989 }
990
991 /*@C
992 PetscTokenDestroy - Destroys a PetscToken
993
994 Not Collective
995
996 Input Parameters:
997 . a - pointer to token
998
999 Level: intermediate
1000
1001 Notes:
1002 Not for use in Fortran
1003
1004 .seealso: PetscTokenCreate(), PetscTokenFind()
1005 @*/
PetscTokenDestroy(PetscToken * a)1006 PetscErrorCode PetscTokenDestroy(PetscToken *a)
1007 {
1008 PetscErrorCode ierr;
1009
1010 PetscFunctionBegin;
1011 if (!*a) PetscFunctionReturn(0);
1012 ierr = PetscFree((*a)->array);CHKERRQ(ierr);
1013 ierr = PetscFree(*a);CHKERRQ(ierr);
1014 PetscFunctionReturn(0);
1015 }
1016
1017 /*@C
1018 PetscStrInList - search string in character-delimited list
1019
1020 Not Collective
1021
1022 Input Parameters:
1023 + str - the string to look for
1024 . list - the list to search in
1025 - sep - the separator character
1026
1027 Output Parameter:
1028 . found - whether str is in list
1029
1030 Level: intermediate
1031
1032 Notes:
1033 Not for use in Fortran
1034
1035 .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1036 @*/
PetscStrInList(const char str[],const char list[],char sep,PetscBool * found)1037 PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1038 {
1039 PetscToken token;
1040 char *item;
1041 PetscErrorCode ierr;
1042
1043 PetscFunctionBegin;
1044 *found = PETSC_FALSE;
1045 ierr = PetscTokenCreate(list,sep,&token);CHKERRQ(ierr);
1046 ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1047 while (item) {
1048 ierr = PetscStrcmp(str,item,found);CHKERRQ(ierr);
1049 if (*found) break;
1050 ierr = PetscTokenFind(token,&item);CHKERRQ(ierr);
1051 }
1052 ierr = PetscTokenDestroy(&token);CHKERRQ(ierr);
1053 PetscFunctionReturn(0);
1054 }
1055
1056 /*@C
1057 PetscGetPetscDir - Gets the directory PETSc is installed in
1058
1059 Not Collective
1060
1061 Output Parameter:
1062 . dir - the directory
1063
1064 Level: developer
1065
1066 Notes:
1067 Not for use in Fortran
1068
1069 @*/
PetscGetPetscDir(const char * dir[])1070 PetscErrorCode PetscGetPetscDir(const char *dir[])
1071 {
1072 PetscFunctionBegin;
1073 *dir = PETSC_DIR;
1074 PetscFunctionReturn(0);
1075 }
1076
1077 /*@C
1078 PetscStrreplace - Replaces substrings in string with other substrings
1079
1080 Not Collective
1081
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
1087
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.
1092
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.
1095
1096 Not for use in Fortran
1097
1098 Level: intermediate
1099
1100 @*/
PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)1101 PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1102 {
1103 PetscErrorCode ierr;
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;
1110 static size_t DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;
1111
1112 PetscFunctionBegin;
1113 if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1114 if (aa == b) {
1115 ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr);
1116 }
1117 ierr = PetscMalloc1(len,&work);CHKERRQ(ierr);
1118
1119 /* get values for replaced variables */
1120 ierr = PetscStrallocpy(PETSC_ARCH,&r[0]);CHKERRQ(ierr);
1121 ierr = PetscStrallocpy(PETSC_DIR,&r[1]);CHKERRQ(ierr);
1122 ierr = PetscStrallocpy(PETSC_LIB_DIR,&r[2]);CHKERRQ(ierr);
1123 ierr = PetscMalloc1(DISPLAY_LENGTH,&r[3]);CHKERRQ(ierr);
1124 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr);
1125 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr);
1126 ierr = PetscMalloc1(USER_LENGTH,&r[6]);CHKERRQ(ierr);
1127 ierr = PetscMalloc1(HOST_LENGTH,&r[7]);CHKERRQ(ierr);
1128 ierr = PetscGetDisplay(r[3],DISPLAY_LENGTH);CHKERRQ(ierr);
1129 ierr = PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1130 ierr = PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1131 ierr = PetscGetUserName(r[6],USER_LENGTH);CHKERRQ(ierr);
1132 ierr = PetscGetHostName(r[7],HOST_LENGTH);CHKERRQ(ierr);
1133
1134 /* replace that are in environment */
1135 ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);CHKERRQ(ierr);
1136 if (flag) {
1137 ierr = PetscFree(r[2]);CHKERRQ(ierr);
1138 ierr = PetscStrallocpy(env,&r[2]);CHKERRQ(ierr);
1139 }
1140
1141 /* replace the requested strings */
1142 ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
1143 while (s[i]) {
1144 ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
1145 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1146 while (par) {
1147 *par = 0;
1148 par += l;
1149
1150 ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
1151 ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
1152 ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
1153 if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1154 ierr = PetscStrncpy(work,b,len);CHKERRQ(ierr);
1155 ierr = PetscStrlcat(work,r[i],len);CHKERRQ(ierr);
1156 ierr = PetscStrlcat(work,par,len);CHKERRQ(ierr);
1157 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1158 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1159 }
1160 i++;
1161 }
1162 i = 0;
1163 while (r[i]) {
1164 tfree = (char*)r[i];
1165 ierr = PetscFree(tfree);CHKERRQ(ierr);
1166 i++;
1167 }
1168
1169 /* look for any other ${xxx} strings to replace from environmental variables */
1170 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1171 while (par) {
1172 *par = 0;
1173 par += 2;
1174 ierr = PetscStrncpy(work,b,len);CHKERRQ(ierr);
1175 ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
1176 *epar = 0;
1177 epar += 1;
1178 ierr = PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);CHKERRQ(ierr);
1179 if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1180 ierr = PetscStrlcat(work,env,len);CHKERRQ(ierr);
1181 ierr = PetscStrlcat(work,epar,len);CHKERRQ(ierr);
1182 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1183 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1184 }
1185 ierr = PetscFree(work);CHKERRQ(ierr);
1186 if (aa == b) {
1187 ierr = PetscFree(a);CHKERRQ(ierr);
1188 }
1189 PetscFunctionReturn(0);
1190 }
1191
1192 /*@C
1193 PetscEListFind - searches list of strings for given string, using case insensitive matching
1194
1195 Not Collective
1196
1197 Input Parameters:
1198 + n - number of strings in
1199 . list - list of strings to search
1200 - str - string to look for, empty string "" accepts default (first entry in list)
1201
1202 Output Parameters:
1203 + value - index of matching string (if found)
1204 - found - boolean indicating whether string was found (can be NULL)
1205
1206 Notes:
1207 Not for use in Fortran
1208
1209 Level: advanced
1210 @*/
PetscEListFind(PetscInt n,const char * const * list,const char * str,PetscInt * value,PetscBool * found)1211 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1212 {
1213 PetscErrorCode ierr;
1214 PetscBool matched;
1215 PetscInt i;
1216
1217 PetscFunctionBegin;
1218 if (found) *found = PETSC_FALSE;
1219 for (i=0; i<n; i++) {
1220 ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr);
1221 if (matched || !str[0]) {
1222 if (found) *found = PETSC_TRUE;
1223 *value = i;
1224 break;
1225 }
1226 }
1227 PetscFunctionReturn(0);
1228 }
1229
1230 /*@C
1231 PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1232
1233 Not Collective
1234
1235 Input Parameters:
1236 + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1237 - str - string to look for
1238
1239 Output Parameters:
1240 + value - index of matching string (if found)
1241 - found - boolean indicating whether string was found (can be NULL)
1242
1243 Notes:
1244 Not for use in Fortran
1245
1246 Level: advanced
1247 @*/
PetscEnumFind(const char * const * enumlist,const char * str,PetscEnum * value,PetscBool * found)1248 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1249 {
1250 PetscErrorCode ierr;
1251 PetscInt n = 0,evalue;
1252 PetscBool efound;
1253
1254 PetscFunctionBegin;
1255 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");
1256 if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1257 n -= 3; /* drop enum name, prefix, and null termination */
1258 ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr);
1259 if (efound) *value = (PetscEnum)evalue;
1260 if (found) *found = efound;
1261 PetscFunctionReturn(0);
1262 }
1263