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 <petsc/private/petscimpl.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 Note: 28 this may be called before PetscInitialize() or after PetscFinalize() 29 30 Fortran Note: 31 Not for use in Fortran 32 33 Developer Notes: 34 Uses raw `malloc()` and does not call error handlers since this may be used before PETSc is initialized. 35 36 Used to generate argc, args arguments passed to `MPI_Init()` 37 38 .seealso: `PetscStrToArrayDestroy()`, `PetscToken`, `PetscTokenCreate()` 39 @*/ 40 PetscErrorCode PetscStrToArray(const char s[], char sp, int *argc, char ***args) 41 { 42 int i, j, n, *lens, cnt = 0; 43 PetscBool flg = PETSC_FALSE; 44 45 if (!s) n = 0; 46 else n = strlen(s); 47 *argc = 0; 48 *args = NULL; 49 for (; n > 0; n--) { /* remove separator chars at the end - and will empty the string if all chars are separator chars */ 50 if (s[n - 1] != sp) break; 51 } 52 if (!n) return 0; 53 for (i = 0; i < n; i++) { 54 if (s[i] != sp) break; 55 } 56 for (; i < n + 1; i++) { 57 if ((s[i] == sp || s[i] == 0) && !flg) { 58 flg = PETSC_TRUE; 59 (*argc)++; 60 } else if (s[i] != sp) { 61 flg = PETSC_FALSE; 62 } 63 } 64 (*args) = (char **)malloc(((*argc) + 1) * sizeof(char *)); 65 if (!*args) return PETSC_ERR_MEM; 66 lens = (int *)malloc((*argc) * sizeof(int)); 67 if (!lens) return PETSC_ERR_MEM; 68 for (i = 0; i < *argc; i++) lens[i] = 0; 69 70 *argc = 0; 71 for (i = 0; i < n; i++) { 72 if (s[i] != sp) break; 73 } 74 for (; i < n + 1; i++) { 75 if ((s[i] == sp || s[i] == 0) && !flg) { 76 flg = PETSC_TRUE; 77 (*argc)++; 78 } else if (s[i] != sp) { 79 lens[*argc]++; 80 flg = PETSC_FALSE; 81 } 82 } 83 84 for (i = 0; i < *argc; i++) { 85 (*args)[i] = (char *)malloc((lens[i] + 1) * sizeof(char)); 86 if (!(*args)[i]) { 87 free(lens); 88 for (j = 0; j < i; j++) free((*args)[j]); 89 free(*args); 90 return PETSC_ERR_MEM; 91 } 92 } 93 free(lens); 94 (*args)[*argc] = NULL; 95 96 *argc = 0; 97 for (i = 0; i < n; i++) { 98 if (s[i] != sp) break; 99 } 100 for (; i < n + 1; i++) { 101 if ((s[i] == sp || s[i] == 0) && !flg) { 102 flg = PETSC_TRUE; 103 (*args)[*argc][cnt++] = 0; 104 (*argc)++; 105 cnt = 0; 106 } else if (s[i] != sp && s[i] != 0) { 107 (*args)[*argc][cnt++] = s[i]; 108 flg = PETSC_FALSE; 109 } 110 } 111 return 0; 112 } 113 114 /*@C 115 PetscStrToArrayDestroy - Frees array created with `PetscStrToArray()`. 116 117 Not Collective 118 119 Output Parameters: 120 + argc - the number of arguments 121 - args - the array of arguments 122 123 Level: intermediate 124 125 Note: 126 This may be called before `PetscInitialize()` or after `PetscFinalize()` 127 128 Fortran Note: 129 Not for use in Fortran 130 131 .seealso: `PetscStrToArray()` 132 @*/ 133 PetscErrorCode PetscStrToArrayDestroy(int argc, char **args) 134 { 135 for (int i = 0; i < argc; ++i) free(args[i]); 136 if (args) free(args); 137 return 0; 138 } 139 140 /*@C 141 PetscStrlen - Gets length of a string 142 143 Not Collective 144 145 Input Parameters: 146 . s - pointer to string 147 148 Output Parameter: 149 . len - length in bytes 150 151 Level: intermediate 152 153 Note: 154 This routine is analogous to `strlen()`. 155 156 Null string returns a length of zero 157 158 Fortran Note: 159 Not for use in Fortran 160 161 .seealso: `PetscStrallocpy()` 162 @*/ 163 PetscErrorCode PetscStrlen(const char s[], size_t *len) 164 { 165 PetscFunctionBegin; 166 *len = s ? strlen(s) : 0; 167 PetscFunctionReturn(0); 168 } 169 170 /*@C 171 PetscStrallocpy - Allocates space to hold a copy of a string then copies the string in the new space 172 173 Not Collective 174 175 Input Parameters: 176 . s - pointer to string 177 178 Output Parameter: 179 . t - the copied string 180 181 Level: intermediate 182 183 Notes: 184 Null string returns a new null string 185 186 If t has previously been allocated then that memory is lost, you may need to PetscFree() 187 the array before calling this routine. 188 189 Fortran Note: 190 Not for use in Fortran 191 192 .seealso: `PetscStrArrayallocpy()`, `PetscStrcpy()`, `PetscStrNArrayallocpy()` 193 @*/ 194 PetscErrorCode PetscStrallocpy(const char s[], char *t[]) 195 { 196 char *tmp = NULL; 197 198 PetscFunctionBegin; 199 if (s) { 200 size_t len; 201 202 PetscCall(PetscStrlen(s, &len)); 203 PetscCall(PetscMalloc1(1 + len, &tmp)); 204 PetscCall(PetscStrcpy(tmp, s)); 205 } 206 *t = tmp; 207 PetscFunctionReturn(0); 208 } 209 210 /*@C 211 PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings 212 213 Not Collective 214 215 Input Parameters: 216 . s - pointer to array of strings (final string is a null) 217 218 Output Parameter: 219 . t - the copied array string 220 221 Level: intermediate 222 223 Note: 224 If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy() 225 the array before calling this routine. 226 227 Fortran Note: 228 Not for use in Fortran 229 230 .seealso: `PetscStrallocpy()`, `PetscStrArrayDestroy()`, `PetscStrNArrayallocpy()` 231 @*/ 232 PetscErrorCode PetscStrArrayallocpy(const char *const *list, char ***t) 233 { 234 PetscInt n = 0; 235 236 PetscFunctionBegin; 237 while (list[n++]) 238 ; 239 PetscCall(PetscMalloc1(n + 1, t)); 240 for (PetscInt i = 0; i < n; i++) PetscCall(PetscStrallocpy(list[i], (*t) + i)); 241 (*t)[n] = NULL; 242 PetscFunctionReturn(0); 243 } 244 245 /*@C 246 PetscStrArrayDestroy - Frees array of strings created with `PetscStrArrayallocpy()`. 247 248 Not Collective 249 250 Output Parameters: 251 . list - array of strings 252 253 Level: intermediate 254 255 Fortran Note: 256 Not for use in Fortran 257 258 .seealso: `PetscStrArrayallocpy()` 259 @*/ 260 PetscErrorCode PetscStrArrayDestroy(char ***list) 261 { 262 PetscInt n = 0; 263 264 PetscFunctionBegin; 265 if (!*list) PetscFunctionReturn(0); 266 while ((*list)[n]) { 267 PetscCall(PetscFree((*list)[n])); 268 ++n; 269 } 270 PetscCall(PetscFree(*list)); 271 PetscFunctionReturn(0); 272 } 273 274 /*@C 275 PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings 276 277 Not Collective 278 279 Input Parameters: 280 + n - the number of string entries 281 - s - pointer to array of strings 282 283 Output Parameter: 284 . t - the copied array string 285 286 Level: intermediate 287 288 Fortran Note: 289 Not for use in Fortran 290 291 .seealso: `PetscStrallocpy()`, `PetscStrArrayallocpy()`, `PetscStrNArrayDestroy()` 292 @*/ 293 PetscErrorCode PetscStrNArrayallocpy(PetscInt n, const char *const *list, char ***t) 294 { 295 PetscFunctionBegin; 296 PetscCall(PetscMalloc1(n, t)); 297 for (PetscInt i = 0; i < n; i++) PetscCall(PetscStrallocpy(list[i], (*t) + i)); 298 PetscFunctionReturn(0); 299 } 300 301 /*@C 302 PetscStrNArrayDestroy - Frees array of strings created with `PetscStrNArrayallocpy()`. 303 304 Not Collective 305 306 Output Parameters: 307 + n - number of string entries 308 - list - array of strings 309 310 Level: intermediate 311 312 Fortran Note: 313 Not for use in Fortran 314 315 .seealso: `PetscStrNArrayallocpy()`, `PetscStrArrayallocpy()` 316 @*/ 317 PetscErrorCode PetscStrNArrayDestroy(PetscInt n, char ***list) 318 { 319 PetscFunctionBegin; 320 if (!*list) PetscFunctionReturn(0); 321 for (PetscInt i = 0; i < n; i++) PetscCall(PetscFree((*list)[i])); 322 PetscCall(PetscFree(*list)); 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 It is recommended you use `PetscStrncpy()` instead of this routine 343 344 Fortran Note: 345 Not for use in Fortran 346 347 .seealso: `PetscStrncpy()`, `PetscStrcat()`, `PetscStrlcat()`, `PetscStrallocpy()` 348 @*/ 349 350 PetscErrorCode PetscStrcpy(char s[], const char t[]) 351 { 352 PetscFunctionBegin; 353 if (t) { 354 PetscValidCharPointer(s, 1); 355 PetscValidCharPointer(t, 2); 356 strcpy(s, t); 357 } else if (s) s[0] = 0; 358 PetscFunctionReturn(0); 359 } 360 361 /*@C 362 PetscStrncpy - Copies a string up to a certain length 363 364 Not Collective 365 366 Input Parameters: 367 + t - pointer to string 368 - n - the length to copy 369 370 Output Parameter: 371 . s - the copied string 372 373 Level: intermediate 374 375 Note: 376 Null string returns a string starting with zero 377 378 If the string that is being copied is of length n or larger then the entire string is not 379 copied and the final location of s is set to NULL. This is different then the behavior of 380 `strncpy()` which leaves s non-terminated if there is not room for the entire string. 381 382 Developers Note: 383 Should this be `PetscStrlcpy()` to reflect its behavior which is like `strlcpy()` not `strncpy()` 384 385 .seealso: `PetscStrcpy()`, `PetscStrcat()`, `PetscStrlcat()`, `PetscStrallocpy()` 386 @*/ 387 PetscErrorCode PetscStrncpy(char s[], const char t[], size_t n) 388 { 389 PetscFunctionBegin; 390 if (s) PetscCheck(n, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "Requires an output string of length at least 1 to hold the termination character"); 391 if (t) { 392 PetscValidCharPointer(s, 1); 393 if (n > 1) { 394 strncpy(s, t, n - 1); 395 s[n - 1] = '\0'; 396 } else { 397 s[0] = '\0'; 398 } 399 } else if (s) s[0] = 0; 400 PetscFunctionReturn(0); 401 } 402 403 /*@C 404 PetscStrcat - Concatenates a string onto a given string 405 406 Not Collective 407 408 Input Parameters: 409 + s - string to be added to 410 - t - pointer to string to be added to end 411 412 Level: intermediate 413 414 Note: 415 It is recommended you use `PetscStrlcat()` instead of this routine 416 417 Fortran Note: 418 Not for use in Fortran 419 420 .seealso: `PetscStrcpy()`, `PetscStrncpy()`, `PetscStrlcat()` 421 @*/ 422 PetscErrorCode PetscStrcat(char s[], const char t[]) 423 { 424 PetscFunctionBegin; 425 if (!t) PetscFunctionReturn(0); 426 PetscValidCharPointer(s, 1); 427 PetscValidCharPointer(t, 2); 428 strcat(s, t); 429 PetscFunctionReturn(0); 430 } 431 432 /*@C 433 PetscStrlcat - Concatenates a string onto a given string, up to a given length 434 435 Not Collective 436 437 Input Parameters: 438 + s - pointer to string to be added to at end 439 . t - string to be added 440 - n - length of the original allocated string 441 442 Level: intermediate 443 444 Note: 445 Unlike the system call `strncat()`, the length passed in is the length of the 446 original allocated space, not the length of the left-over space. This is 447 similar to the BSD system call `strlcat()`. 448 449 Fortran Note: 450 Not for use in Fortran 451 452 .seealso: `PetscStrcpy()`, `PetscStrncpy()`, `PetscStrcat()` 453 @*/ 454 PetscErrorCode PetscStrlcat(char s[], const char t[], size_t n) 455 { 456 size_t len; 457 458 PetscFunctionBegin; 459 if (!t) PetscFunctionReturn(0); 460 PetscValidCharPointer(s, 1); 461 PetscValidCharPointer(t, 2); 462 PetscCheck(n, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "String buffer length must be positive"); 463 PetscCall(PetscStrlen(t, &len)); 464 strncat(s, t, n - len); 465 s[n - 1] = 0; 466 PetscFunctionReturn(0); 467 } 468 469 void PetscStrcmpNoError(const char a[], const char b[], PetscBool *flg) 470 { 471 if (!a && !b) *flg = PETSC_TRUE; 472 else if (!a || !b) *flg = PETSC_FALSE; 473 else *flg = strcmp(a, b) ? PETSC_FALSE : PETSC_TRUE; 474 } 475 476 /*@C 477 PetscBasename - returns a pointer to the last entry of a / or \ separated directory path 478 479 Not Collective 480 481 Input Parameter: 482 . a - pointer to string 483 484 Level: intermediate 485 486 Fortran Note: 487 Not for use in Fortran 488 489 .seealso: `PetscStrgrt()`, `PetscStrncmp()`, `PetscStrcasecmp()`, `PetscStrrchr()`,`PetscStrcmp()`,`PetscStrstr()`, 490 `PetscTokenCreate()`, `PetscStrToArray()`, `PetscStrInList()` 491 @*/ 492 const char *PetscBasename(const char a[]) 493 { 494 const char *ptr; 495 496 if (PetscStrrchr(a, '/', (char **)&ptr)) ptr = NULL; 497 if (ptr == a) { 498 if (PetscStrrchr(a, '\\', (char **)&ptr)) ptr = NULL; 499 } 500 return ptr; 501 } 502 503 /*@C 504 PetscStrcmp - Compares two strings, 505 506 Not Collective 507 508 Input Parameters: 509 + a - pointer to string first string 510 - b - pointer to second string 511 512 Output Parameter: 513 . flg - `PETSC_TRUE` if the two strings are equal 514 515 Level: intermediate 516 517 Fortran Note: 518 Not for use in Fortran 519 520 .seealso: `PetscStrgrt()`, `PetscStrncmp()`, `PetscStrcasecmp()` 521 @*/ 522 PetscErrorCode PetscStrcmp(const char a[], const char b[], PetscBool *flg) 523 { 524 PetscFunctionBegin; 525 PetscValidBoolPointer(flg, 3); 526 if (!a && !b) *flg = PETSC_TRUE; 527 else if (!a || !b) *flg = PETSC_FALSE; 528 else *flg = (PetscBool)!strcmp(a, b); 529 PetscFunctionReturn(0); 530 } 531 532 /*@C 533 PetscStrgrt - If first string is greater than the second 534 535 Not Collective 536 537 Input Parameters: 538 + a - pointer to first string 539 - b - pointer to second string 540 541 Output Parameter: 542 . flg - if the first string is greater 543 544 Note: 545 Null arguments are ok, a null string is considered smaller than 546 all others 547 548 Fortran Note: 549 Not for use in Fortran 550 551 Level: intermediate 552 553 .seealso: `PetscStrcmp()`, `PetscStrncmp()`, `PetscStrcasecmp()` 554 @*/ 555 PetscErrorCode PetscStrgrt(const char a[], const char b[], PetscBool *t) 556 { 557 PetscFunctionBegin; 558 PetscValidBoolPointer(t, 3); 559 if (!a && !b) *t = PETSC_FALSE; 560 else if (a && !b) *t = PETSC_TRUE; 561 else if (!a && b) *t = PETSC_FALSE; 562 else { 563 PetscValidCharPointer(a, 1); 564 PetscValidCharPointer(b, 2); 565 *t = strcmp(a, b) > 0 ? PETSC_TRUE : PETSC_FALSE; 566 } 567 PetscFunctionReturn(0); 568 } 569 570 /*@C 571 PetscStrcasecmp - Returns true if the two strings are the same 572 except possibly for case. 573 574 Not Collective 575 576 Input Parameters: 577 + a - pointer to first string 578 - b - pointer to second string 579 580 Output Parameter: 581 . flg - if the two strings are the same 582 583 Note: 584 Null arguments are ok 585 586 Fortran Note: 587 Not for use in Fortran 588 589 Level: intermediate 590 591 .seealso: `PetscStrcmp()`, `PetscStrncmp()`, `PetscStrgrt()` 592 @*/ 593 PetscErrorCode PetscStrcasecmp(const char a[], const char b[], PetscBool *t) 594 { 595 int c; 596 597 PetscFunctionBegin; 598 PetscValidBoolPointer(t, 3); 599 if (!a && !b) c = 0; 600 else if (!a || !b) c = 1; 601 #if defined(PETSC_HAVE_STRCASECMP) 602 else c = strcasecmp(a, b); 603 #elif defined(PETSC_HAVE_STRICMP) 604 else c = stricmp(a, b); 605 #else 606 else { 607 char *aa, *bb; 608 PetscCall(PetscStrallocpy(a, &aa)); 609 PetscCall(PetscStrallocpy(b, &bb)); 610 PetscCall(PetscStrtolower(aa)); 611 PetscCall(PetscStrtolower(bb)); 612 PetscCall(PetscStrcmp(aa, bb, t)); 613 PetscCall(PetscFree(aa)); 614 PetscCall(PetscFree(bb)); 615 PetscFunctionReturn(0); 616 } 617 #endif 618 *t = c ? PETSC_FALSE : PETSC_TRUE; 619 PetscFunctionReturn(0); 620 } 621 622 /*@C 623 PetscStrncmp - Compares two strings, up to a certain length 624 625 Not Collective 626 627 Input Parameters: 628 + a - pointer to first string 629 . b - pointer to second string 630 - n - length to compare up to 631 632 Output Parameter: 633 . t - if the two strings are equal 634 635 Level: intermediate 636 637 Fortran Note: 638 Not for use in Fortran 639 640 .seealso: `PetscStrgrt()`, `PetscStrcmp()`, `PetscStrcasecmp()` 641 @*/ 642 PetscErrorCode PetscStrncmp(const char a[], const char b[], size_t n, PetscBool *t) 643 { 644 PetscFunctionBegin; 645 if (n) { 646 PetscValidCharPointer(a, 1); 647 PetscValidCharPointer(b, 2); 648 } 649 PetscValidBoolPointer(t, 4); 650 *t = strncmp(a, b, n) ? PETSC_FALSE : PETSC_TRUE; 651 PetscFunctionReturn(0); 652 } 653 654 /*@C 655 PetscStrchr - Locates first occurrence of a character in a string 656 657 Not Collective 658 659 Input Parameters: 660 + a - pointer to string 661 - b - character 662 663 Output Parameter: 664 . c - location of occurrence, NULL if not found 665 666 Level: intermediate 667 668 Fortran Note: 669 Not for use in Fortran 670 671 .seealso: `PetscStrrchr()`, `PetscTokenCreate()`, `PetscStrendswith()`, `PetscStrbeginsswith()` 672 @*/ 673 PetscErrorCode PetscStrchr(const char a[], char b, char *c[]) 674 { 675 PetscFunctionBegin; 676 PetscValidCharPointer(a, 1); 677 PetscValidPointer(c, 3); 678 *c = (char *)strchr(a, b); 679 PetscFunctionReturn(0); 680 } 681 682 /*@C 683 PetscStrrchr - Locates one location past the last occurrence of a character in a string, 684 if the character is not found then returns entire string 685 686 Not Collective 687 688 Input Parameters: 689 + a - pointer to string 690 - b - character 691 692 Output Parameter: 693 . tmp - location of occurrence, a if not found 694 695 Level: intermediate 696 697 Fortran Note: 698 Not for use in Fortran 699 700 .seealso: `PetscStrchr()`, `PetscTokenCreate()`, `PetscStrendswith()`, `PetscStrbeginsswith()` 701 @*/ 702 PetscErrorCode PetscStrrchr(const char a[], char b, char *tmp[]) 703 { 704 PetscFunctionBegin; 705 PetscValidCharPointer(a, 1); 706 PetscValidPointer(tmp, 3); 707 *tmp = (char *)strrchr(a, b); 708 if (!*tmp) *tmp = (char *)a; 709 else *tmp = *tmp + 1; 710 PetscFunctionReturn(0); 711 } 712 713 /*@C 714 PetscStrtolower - Converts string to lower case 715 716 Not Collective 717 718 Input Parameters: 719 . a - pointer to string 720 721 Level: intermediate 722 723 Fortran Note: 724 Not for use in Fortran 725 726 .seealso: `PetscStrtoupper()` 727 @*/ 728 PetscErrorCode PetscStrtolower(char a[]) 729 { 730 PetscFunctionBegin; 731 PetscValidCharPointer(a, 1); 732 while (*a) { 733 if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A'; 734 a++; 735 } 736 PetscFunctionReturn(0); 737 } 738 739 /*@C 740 PetscStrtoupper - Converts string to upper case 741 742 Not Collective 743 744 Input Parameters: 745 . a - pointer to string 746 747 Level: intermediate 748 749 Fortran Note: 750 Not for use in Fortran 751 752 .seealso: `PetscStrtolower()` 753 @*/ 754 PetscErrorCode PetscStrtoupper(char a[]) 755 { 756 PetscFunctionBegin; 757 PetscValidCharPointer(a, 1); 758 while (*a) { 759 if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a'; 760 a++; 761 } 762 PetscFunctionReturn(0); 763 } 764 765 /*@C 766 PetscStrendswith - Determines if a string ends with a certain string 767 768 Not Collective 769 770 Input Parameters: 771 + a - pointer to string 772 - b - string to endwith 773 774 Output Parameter: 775 . flg - `PETSC_TRUE` or `PETSC_FALSE` 776 777 Fortran Note: 778 Not for use in Fortran 779 780 Level: intermediate 781 782 .seealso: `PetscStrendswithwhich()`, `PetscStrbeginswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`, 783 `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()` 784 @*/ 785 PetscErrorCode PetscStrendswith(const char a[], const char b[], PetscBool *flg) 786 { 787 char *test; 788 789 PetscFunctionBegin; 790 PetscValidBoolPointer(flg, 3); 791 *flg = PETSC_FALSE; 792 PetscCall(PetscStrrstr(a, b, &test)); 793 if (test) { 794 size_t na, nb; 795 796 PetscCall(PetscStrlen(a, &na)); 797 PetscCall(PetscStrlen(b, &nb)); 798 if (a + na - nb == test) *flg = PETSC_TRUE; 799 } 800 PetscFunctionReturn(0); 801 } 802 803 /*@C 804 PetscStrbeginswith - Determines if a string begins with a certain string 805 806 Not Collective 807 808 Input Parameters: 809 + a - pointer to string 810 - b - string to begin with 811 812 Output Parameter: 813 . flg - PETSC_TRUE or PETSC_FALSE 814 815 Fortran Note: 816 Not for use in Fortran 817 818 Level: intermediate 819 820 .seealso: `PetscStrendswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`, 821 `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()` 822 @*/ 823 PetscErrorCode PetscStrbeginswith(const char a[], const char b[], PetscBool *flg) 824 { 825 char *test; 826 827 PetscFunctionBegin; 828 PetscValidCharPointer(a, 1); 829 PetscValidCharPointer(b, 2); 830 PetscValidBoolPointer(flg, 3); 831 *flg = PETSC_FALSE; 832 PetscCall(PetscStrrstr(a, b, &test)); 833 if (test && (test == a)) *flg = PETSC_TRUE; 834 PetscFunctionReturn(0); 835 } 836 837 /*@C 838 PetscStrendswithwhich - Determines if a string ends with one of several possible strings 839 840 Not Collective 841 842 Input Parameters: 843 + a - pointer to string 844 - bs - strings to end with (last entry must be NULL) 845 846 Output Parameter: 847 . cnt - the index of the string it ends with or the index of NULL 848 849 Fortran Note: 850 Not for use in Fortran 851 852 Level: intermediate 853 854 .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`, 855 `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()` 856 @*/ 857 PetscErrorCode PetscStrendswithwhich(const char a[], const char *const *bs, PetscInt *cnt) 858 { 859 PetscFunctionBegin; 860 PetscValidPointer(bs, 2); 861 PetscValidIntPointer(cnt, 3); 862 *cnt = 0; 863 while (bs[*cnt]) { 864 PetscBool flg; 865 866 PetscCall(PetscStrendswith(a, bs[*cnt], &flg)); 867 if (flg) PetscFunctionReturn(0); 868 ++(*cnt); 869 } 870 PetscFunctionReturn(0); 871 } 872 873 /*@C 874 PetscStrrstr - Locates last occurrence of string in another string 875 876 Not Collective 877 878 Input Parameters: 879 + a - pointer to string 880 - b - string to find 881 882 Output Parameter: 883 . tmp - location of occurrence 884 885 Fortran Note: 886 Not for use in Fortran 887 888 Level: intermediate 889 890 .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`, 891 `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()` 892 @*/ 893 PetscErrorCode PetscStrrstr(const char a[], const char b[], char *tmp[]) 894 { 895 const char *ltmp = NULL; 896 897 PetscFunctionBegin; 898 PetscValidCharPointer(a, 1); 899 PetscValidCharPointer(b, 2); 900 PetscValidPointer(tmp, 3); 901 while (a) { 902 a = (char *)strstr(a, b); 903 if (a) ltmp = a++; 904 } 905 *tmp = (char *)ltmp; 906 PetscFunctionReturn(0); 907 } 908 909 /*@C 910 PetscStrstr - Locates first occurrence of string in another string 911 912 Not Collective 913 914 Input Parameters: 915 + haystack - string to search 916 - needle - string to find 917 918 Output Parameter: 919 . tmp - location of occurrence, is a NULL if the string is not found 920 921 Fortran Note: 922 Not for use in Fortran 923 924 Level: intermediate 925 926 .seealso: `PetscStrbeginswithwhich()`, `PetscStrendswith()`, `PetscStrtoupper`, `PetscStrtolower()`, `PetscStrrchr()`, `PetscStrchr()`, 927 `PetscStrncmp()`, `PetscStrlen()`, `PetscStrncmp()`, `PetscStrcmp()` 928 @*/ 929 PetscErrorCode PetscStrstr(const char haystack[], const char needle[], char *tmp[]) 930 { 931 PetscFunctionBegin; 932 PetscValidCharPointer(haystack, 1); 933 PetscValidCharPointer(needle, 2); 934 PetscValidPointer(tmp, 3); 935 *tmp = (char *)strstr(haystack, needle); 936 PetscFunctionReturn(0); 937 } 938 939 struct _p_PetscToken { 940 char token; 941 char *array; 942 char *current; 943 }; 944 945 /*@C 946 PetscTokenFind - Locates next "token" in a string 947 948 Not Collective 949 950 Input Parameters: 951 . a - pointer to token 952 953 Output Parameter: 954 . result - location of occurrence, NULL if not found 955 956 Notes: 957 This version is different from the system version in that 958 it allows you to pass a read-only string into the function. 959 960 This version also treats all characters etc. inside a double quote " 961 as a single token. 962 963 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 964 second will return a null terminated y 965 966 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 967 968 Fortran Note: 969 Not for use in Fortran 970 971 Level: intermediate 972 973 .seealso: `PetscTokenCreate()`, `PetscTokenDestroy()` 974 @*/ 975 PetscErrorCode PetscTokenFind(PetscToken a, char *result[]) 976 { 977 char *ptr, token; 978 979 PetscFunctionBegin; 980 PetscValidPointer(a, 1); 981 PetscValidPointer(result, 2); 982 *result = ptr = a->current; 983 if (ptr && !*ptr) { 984 *result = NULL; 985 PetscFunctionReturn(0); 986 } 987 token = a->token; 988 if (ptr && (*ptr == '"')) { 989 token = '"'; 990 (*result)++; 991 ptr++; 992 } 993 while (ptr) { 994 if (*ptr == token) { 995 *ptr++ = 0; 996 while (*ptr == a->token) ptr++; 997 a->current = ptr; 998 break; 999 } 1000 if (!*ptr) { 1001 a->current = NULL; 1002 break; 1003 } 1004 ptr++; 1005 } 1006 PetscFunctionReturn(0); 1007 } 1008 1009 /*@C 1010 PetscTokenCreate - Creates a `PetscToken` used to find tokens in a string 1011 1012 Not Collective 1013 1014 Input Parameters: 1015 + string - the string to look in 1016 - b - the separator character 1017 1018 Output Parameter: 1019 . t- the token object 1020 1021 Note: 1022 This version is different from the system version in that 1023 it allows you to pass a read-only string into the function. 1024 1025 Fortran Note: 1026 Not for use in Fortran 1027 1028 Level: intermediate 1029 1030 .seealso: `PetscTokenFind()`, `PetscTokenDestroy()` 1031 @*/ 1032 PetscErrorCode PetscTokenCreate(const char a[], const char b, PetscToken *t) 1033 { 1034 PetscFunctionBegin; 1035 PetscValidCharPointer(a, 1); 1036 PetscValidPointer(t, 3); 1037 PetscCall(PetscNew(t)); 1038 PetscCall(PetscStrallocpy(a, &(*t)->array)); 1039 1040 (*t)->current = (*t)->array; 1041 (*t)->token = b; 1042 PetscFunctionReturn(0); 1043 } 1044 1045 /*@C 1046 PetscTokenDestroy - Destroys a `PetscToken` 1047 1048 Not Collective 1049 1050 Input Parameters: 1051 . a - pointer to token 1052 1053 Level: intermediate 1054 1055 Fortran Note: 1056 Not for use in Fortran 1057 1058 .seealso: `PetscTokenCreate()`, `PetscTokenFind()` 1059 @*/ 1060 PetscErrorCode PetscTokenDestroy(PetscToken *a) 1061 { 1062 PetscFunctionBegin; 1063 if (!*a) PetscFunctionReturn(0); 1064 PetscCall(PetscFree((*a)->array)); 1065 PetscCall(PetscFree(*a)); 1066 PetscFunctionReturn(0); 1067 } 1068 1069 /*@C 1070 PetscStrInList - search for string in character-delimited list 1071 1072 Not Collective 1073 1074 Input Parameters: 1075 + str - the string to look for 1076 . list - the list to search in 1077 - sep - the separator character 1078 1079 Output Parameter: 1080 . found - whether str is in list 1081 1082 Level: intermediate 1083 1084 Fortran Note: 1085 Not for use in Fortran 1086 1087 .seealso: `PetscTokenCreate()`, `PetscTokenFind()`, `PetscStrcmp()` 1088 @*/ 1089 PetscErrorCode PetscStrInList(const char str[], const char list[], char sep, PetscBool *found) 1090 { 1091 PetscToken token; 1092 char *item; 1093 1094 PetscFunctionBegin; 1095 PetscValidBoolPointer(found, 4); 1096 *found = PETSC_FALSE; 1097 PetscCall(PetscTokenCreate(list, sep, &token)); 1098 PetscCall(PetscTokenFind(token, &item)); 1099 while (item) { 1100 PetscCall(PetscStrcmp(str, item, found)); 1101 if (*found) break; 1102 PetscCall(PetscTokenFind(token, &item)); 1103 } 1104 PetscCall(PetscTokenDestroy(&token)); 1105 PetscFunctionReturn(0); 1106 } 1107 1108 /*@C 1109 PetscGetPetscDir - Gets the directory PETSc is installed in 1110 1111 Not Collective 1112 1113 Output Parameter: 1114 . dir - the directory 1115 1116 Level: developer 1117 1118 Fortran Note: 1119 Not for use in Fortran 1120 1121 @*/ 1122 PetscErrorCode PetscGetPetscDir(const char *dir[]) 1123 { 1124 PetscFunctionBegin; 1125 PetscValidPointer(dir, 1); 1126 *dir = PETSC_DIR; 1127 PetscFunctionReturn(0); 1128 } 1129 1130 /*@C 1131 PetscStrreplace - Replaces substrings in string with other substrings 1132 1133 Not Collective 1134 1135 Input Parameters: 1136 + comm - `MPI_Comm` of processors that are processing the string 1137 . aa - the string to look in 1138 . b - the resulting copy of a with replaced strings (b can be the same as a) 1139 - len - the length of b 1140 1141 Notes: 1142 Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY}, 1143 ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values 1144 as well as any environmental variables. 1145 1146 `PETSC_LIB_DIR` uses the environmental variable if it exists. `PETSC_ARCH` and `PETSC_DIR` use what 1147 PETSc was built with and do not use environmental variables. 1148 1149 Fortran Note: 1150 Not for use in Fortran 1151 1152 Level: developer 1153 1154 @*/ 1155 PetscErrorCode PetscStrreplace(MPI_Comm comm, const char aa[], char b[], size_t len) 1156 { 1157 int i = 0; 1158 size_t l, l1, l2, l3; 1159 char *work, *par, *epar, env[1024], *tfree, *a = (char *)aa; 1160 const char *s[] = {"${PETSC_ARCH}", "${PETSC_DIR}", "${PETSC_LIB_DIR}", "${DISPLAY}", "${HOMEDIRECTORY}", "${WORKINGDIRECTORY}", "${USERNAME}", "${HOSTNAME}", NULL}; 1161 char *r[] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL}; 1162 PetscBool flag; 1163 static size_t DISPLAY_LENGTH = 265, USER_LENGTH = 256, HOST_LENGTH = 256; 1164 1165 PetscFunctionBegin; 1166 PetscValidCharPointer(aa, 2); 1167 PetscValidCharPointer(b, 3); 1168 if (aa == b) PetscCall(PetscStrallocpy(aa, (char **)&a)); 1169 PetscCall(PetscMalloc1(len, &work)); 1170 1171 /* get values for replaced variables */ 1172 PetscCall(PetscStrallocpy(PETSC_ARCH, &r[0])); 1173 PetscCall(PetscStrallocpy(PETSC_DIR, &r[1])); 1174 PetscCall(PetscStrallocpy(PETSC_LIB_DIR, &r[2])); 1175 PetscCall(PetscMalloc1(DISPLAY_LENGTH, &r[3])); 1176 PetscCall(PetscMalloc1(PETSC_MAX_PATH_LEN, &r[4])); 1177 PetscCall(PetscMalloc1(PETSC_MAX_PATH_LEN, &r[5])); 1178 PetscCall(PetscMalloc1(USER_LENGTH, &r[6])); 1179 PetscCall(PetscMalloc1(HOST_LENGTH, &r[7])); 1180 PetscCall(PetscGetDisplay(r[3], DISPLAY_LENGTH)); 1181 PetscCall(PetscGetHomeDirectory(r[4], PETSC_MAX_PATH_LEN)); 1182 PetscCall(PetscGetWorkingDirectory(r[5], PETSC_MAX_PATH_LEN)); 1183 PetscCall(PetscGetUserName(r[6], USER_LENGTH)); 1184 PetscCall(PetscGetHostName(r[7], HOST_LENGTH)); 1185 1186 /* replace that are in environment */ 1187 PetscCall(PetscOptionsGetenv(comm, "PETSC_LIB_DIR", env, sizeof(env), &flag)); 1188 if (flag) { 1189 PetscCall(PetscFree(r[2])); 1190 PetscCall(PetscStrallocpy(env, &r[2])); 1191 } 1192 1193 /* replace the requested strings */ 1194 PetscCall(PetscStrncpy(b, a, len)); 1195 while (s[i]) { 1196 PetscCall(PetscStrlen(s[i], &l)); 1197 PetscCall(PetscStrstr(b, s[i], &par)); 1198 while (par) { 1199 *par = 0; 1200 par += l; 1201 1202 PetscCall(PetscStrlen(b, &l1)); 1203 PetscCall(PetscStrlen(r[i], &l2)); 1204 PetscCall(PetscStrlen(par, &l3)); 1205 PetscCheck(l1 + l2 + l3 < len, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "b len is not long enough to hold new values"); 1206 PetscCall(PetscStrncpy(work, b, len)); 1207 PetscCall(PetscStrlcat(work, r[i], len)); 1208 PetscCall(PetscStrlcat(work, par, len)); 1209 PetscCall(PetscStrncpy(b, work, len)); 1210 PetscCall(PetscStrstr(b, s[i], &par)); 1211 } 1212 i++; 1213 } 1214 i = 0; 1215 while (r[i]) { 1216 tfree = (char *)r[i]; 1217 PetscCall(PetscFree(tfree)); 1218 i++; 1219 } 1220 1221 /* look for any other ${xxx} strings to replace from environmental variables */ 1222 PetscCall(PetscStrstr(b, "${", &par)); 1223 while (par) { 1224 *par = 0; 1225 par += 2; 1226 PetscCall(PetscStrncpy(work, b, len)); 1227 PetscCall(PetscStrstr(par, "}", &epar)); 1228 *epar = 0; 1229 epar += 1; 1230 PetscCall(PetscOptionsGetenv(comm, par, env, sizeof(env), &flag)); 1231 PetscCheck(flag, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Substitution string ${%s} not found as environmental variable", par); 1232 PetscCall(PetscStrlcat(work, env, len)); 1233 PetscCall(PetscStrlcat(work, epar, len)); 1234 PetscCall(PetscStrncpy(b, work, len)); 1235 PetscCall(PetscStrstr(b, "${", &par)); 1236 } 1237 PetscCall(PetscFree(work)); 1238 if (aa == b) PetscCall(PetscFree(a)); 1239 PetscFunctionReturn(0); 1240 } 1241 1242 /*@C 1243 PetscEListFind - searches list of strings for given string, using case insensitive matching 1244 1245 Not Collective 1246 1247 Input Parameters: 1248 + n - number of strings in 1249 . list - list of strings to search 1250 - str - string to look for, empty string "" accepts default (first entry in list) 1251 1252 Output Parameters: 1253 + value - index of matching string (if found) 1254 - found - boolean indicating whether string was found (can be NULL) 1255 1256 Fortran Note: 1257 Not for use in Fortran 1258 1259 Level: advanced 1260 1261 .seealso: `PetscEnumFind()` 1262 @*/ 1263 PetscErrorCode PetscEListFind(PetscInt n, const char *const *list, const char *str, PetscInt *value, PetscBool *found) 1264 { 1265 PetscFunctionBegin; 1266 if (found) { 1267 PetscValidBoolPointer(found, 5); 1268 *found = PETSC_FALSE; 1269 } 1270 for (PetscInt i = 0; i < n; ++i) { 1271 PetscBool matched; 1272 1273 PetscCall(PetscStrcasecmp(str, list[i], &matched)); 1274 if (matched || !str[0]) { 1275 if (found) *found = PETSC_TRUE; 1276 *value = i; 1277 break; 1278 } 1279 } 1280 PetscFunctionReturn(0); 1281 } 1282 1283 /*@C 1284 PetscEnumFind - searches enum list of strings for given string, using case insensitive matching 1285 1286 Not Collective 1287 1288 Input Parameters: 1289 + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL 1290 - str - string to look for 1291 1292 Output Parameters: 1293 + value - index of matching string (if found) 1294 - found - boolean indicating whether string was found (can be NULL) 1295 1296 Fortran Note: 1297 Not for use in Fortran 1298 1299 Level: advanced 1300 1301 .seealso: `PetscEListFind()` 1302 @*/ 1303 PetscErrorCode PetscEnumFind(const char *const *enumlist, const char *str, PetscEnum *value, PetscBool *found) 1304 { 1305 PetscInt n = 0, evalue; 1306 PetscBool efound; 1307 1308 PetscFunctionBegin; 1309 PetscValidPointer(enumlist, 1); 1310 while (enumlist[n++]) PetscCheck(n <= 50, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "List argument appears to be wrong or have more than 50 entries"); 1311 PetscCheck(n >= 3, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "List argument must have at least two entries: typename and type prefix"); 1312 n -= 3; /* drop enum name, prefix, and null termination */ 1313 PetscCall(PetscEListFind(n, enumlist, str, &evalue, &efound)); 1314 if (efound) { 1315 PetscValidPointer(value, 3); 1316 *value = (PetscEnum)evalue; 1317 } 1318 if (found) { 1319 PetscValidBoolPointer(found, 4); 1320 *found = efound; 1321 } 1322 PetscFunctionReturn(0); 1323 } 1324 1325 /*@C 1326 PetscCIFilename - returns the basename of a file name when the PETSc CI portable error output mode is enabled. 1327 1328 Not collective 1329 1330 Input Parameter: 1331 . file - the file name 1332 1333 Note: 1334 PETSc CI mode is a mode of running PETSc where output (both error and non-error) is made portable across all systems 1335 so that comparisons of output between runs are easy to make. 1336 1337 This mode is used for all tests in the test harness, it applies to both debug and optimized builds. 1338 1339 Use the option -petsc_ci to turn on PETSc CI mode. It changes certain output in non-error situations to be portable for 1340 all systems, mainly the output of options. It is passed to all PETSc programs automatically by the test harness. 1341 1342 Always uses the Unix / as the file separate even on Microsoft Windows systems 1343 1344 The option -petsc_ci_portable_error_output attempts to output the same error messages on all systems for the test harness. 1345 In particular the output of filenames and line numbers in PETSc stacks. This is to allow (limited) checking of PETSc 1346 error handling by the test harness. This options also causes PETSc to attempt to return an error code of 0 so that the test 1347 harness can process the output for differences in the usual manner as for successful runs. It should be provided to the test 1348 harness in the args: argument for specific examples. It will not neccessarily produce portable output if different errors 1349 (or no errors) occur on a subset of the MPI ranks. 1350 1351 Level: developer 1352 1353 .seealso: `PetscCILinenumber()` 1354 @*/ 1355 const char *PetscCIFilename(const char *file) 1356 { 1357 if (!PetscCIEnabledPortableErrorOutput) return file; 1358 return PetscBasename(file); 1359 } 1360 1361 /*@C 1362 PetscCILinenumber - returns a line number except if `PetscCIEnablePortableErrorOutput` is set when it returns 0 1363 1364 Not collective 1365 1366 Input Parameter: 1367 . linenumber - the initial line number 1368 1369 Note: 1370 See `PetscCIFilename()` for details on usage 1371 1372 Level: developer 1373 1374 .seealso: `PetscCIFilename()` 1375 @*/ 1376 int PetscCILinenumber(int linenumber) 1377 { 1378 if (!PetscCIEnabledPortableErrorOutput) return linenumber; 1379 return 0; 1380 } 1381