Actual source code: str.c
 
   petsc-3.7.7 2017-09-25
   
  2: /*
  3:     We define the string operations here. The reason we just do not use
  4:   the standard string routines in the PETSc code is that on some machines
  5:   they are broken or have the wrong prototypes.
  7: */
  8: #include <petscsys.h>                   /*I  "petscsys.h"   I*/
  9: #if defined(PETSC_HAVE_STRING_H)
 10: #include <string.h>             /* strstr */
 11: #endif
 12: #if defined(PETSC_HAVE_STRINGS_H)
 13: #  include <strings.h>          /* strcasecmp */
 14: #endif
 18: /*@C
 19:    PetscStrToArray - Separates a string by a charactor (for example ' ' or '\n') and creates an array of strings
 21:    Not Collective
 23:    Input Parameters:
 24: +  s - pointer to string
 25: -  sp - separator charactor
 27:    Output Parameter:
 28: +   argc - the number of entries in the array
 29: -   args - an array of the entries with a null at the end
 31:    Level: intermediate
 33:    Notes: this may be called before PetscInitialize() or after PetscFinalize()
 35:    Not for use in Fortran
 37:    Developer Notes: Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
 38:      to generate argc, args arguments passed to MPI_Init()
 40: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
 42: @*/
 43: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
 44: {
 45:   int       i,j,n,*lens,cnt = 0;
 46:   PetscBool flg = PETSC_FALSE;
 48:   if (!s) n = 0;
 49:   else    n = strlen(s);
 50:   *argc = 0;
 51:   *args = NULL;
 52:   if (!n) {
 53:     return(0);
 54:   }
 55:   for (i=0; i<n; i++) {
 56:     if (s[i] != sp) break;
 57:   }
 58:   for (;i<n+1; i++) {
 59:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 60:     else if (s[i] != sp) {flg = PETSC_FALSE;}
 61:   }
 62:   if (!*argc) { /* string only has separator characters */
 63:     return(0);
 64:   }
 65:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 66:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 67:   for (i=0; i<*argc; i++) lens[i] = 0;
 69:   *argc = 0;
 70:   for (i=0; i<n; i++) {
 71:     if (s[i] != sp) break;
 72:   }
 73:   for (;i<n+1; i++) {
 74:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 75:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
 76:   }
 78:   for (i=0; i<*argc; i++) {
 79:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
 80:     if (!(*args)[i]) {
 81:       free(lens);
 82:       for (j=0; j<i; j++) free((*args)[j]);
 83:       free(*args);
 84:       return PETSC_ERR_MEM;
 85:     }
 86:   }
 87:   free(lens);
 88:   (*args)[*argc] = 0;
 90:   *argc = 0;
 91:   for (i=0; i<n; i++) {
 92:     if (s[i] != sp) break;
 93:   }
 94:   for (;i<n+1; i++) {
 95:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
 96:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
 97:   }
 98:   return 0;
 99: }
103: /*@C
104:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
106:    Not Collective
108:    Output Parameters:
109: +  argc - the number of arguments
110: -  args - the array of arguments
112:    Level: intermediate
114:    Concepts: command line arguments
116:    Notes: This may be called before PetscInitialize() or after PetscFinalize()
118:    Not for use in Fortran
120: .seealso: PetscStrToArray()
122: @*/
123: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
124: {
125:   PetscInt i;
127:   for (i=0; i<argc; i++) free(args[i]);
128:   if (args) free(args);
129:   return 0;
130: }
134: /*@C
135:    PetscStrlen - Gets length of a string
137:    Not Collective
139:    Input Parameters:
140: .  s - pointer to string
142:    Output Parameter:
143: .  len - length in bytes
145:    Level: intermediate
147:    Note:
148:    This routine is analogous to strlen().
150:    Null string returns a length of zero
152:    Not for use in Fortran
154:   Concepts: string length
156: @*/
157: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
158: {
160:   if (!s) *len = 0;
161:   else    *len = strlen(s);
162:   return(0);
163: }
167: /*@C
168:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
170:    Not Collective
172:    Input Parameters:
173: .  s - pointer to string
175:    Output Parameter:
176: .  t - the copied string
178:    Level: intermediate
180:    Note:
181:       Null string returns a new null string
183:       Not for use in Fortran
185:   Concepts: string copy
187: @*/
188: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
189: {
191:   size_t         len;
192:   char           *tmp = 0;
195:   if (s) {
196:     PetscStrlen(s,&len);
197:     PetscMalloc1(1+len,&tmp);
198:     PetscStrcpy(tmp,s);
199:   }
200:   *t = tmp;
201:   return(0);
202: }
206: /*@C
207:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
209:    Not Collective
211:    Input Parameters:
212: .  s - pointer to array of strings (final string is a null)
214:    Output Parameter:
215: .  t - the copied array string
217:    Level: intermediate
219:    Note:
220:       Not for use in Fortran
222:   Concepts: string copy
224: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
226: @*/
227: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
228: {
230:   PetscInt       i,n = 0;
233:   while (list[n++]) ;
234:   PetscMalloc1(n+1,t);
235:   for (i=0; i<n; i++) {
236:     PetscStrallocpy(list[i],(*t)+i);
237:   }
238:   (*t)[n] = NULL;
239:   return(0);
240: }
244: /*@C
245:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
247:    Not Collective
249:    Output Parameters:
250: .   list - array of strings
252:    Level: intermediate
254:    Concepts: command line arguments
256:    Notes: Not for use in Fortran
258: .seealso: PetscStrArrayallocpy()
260: @*/
261: PetscErrorCode PetscStrArrayDestroy(char ***list)
262: {
263:   PetscInt       n = 0;
267:   if (!*list) return(0);
268:   while ((*list)[n]) {
269:     PetscFree((*list)[n]);
270:     n++;
271:   }
272:   PetscFree(*list);
273:   return(0);
274: }
278: /*@C
279:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
281:    Not Collective
283:    Input Parameters:
284: +  n - the number of string entries
285: -  s - pointer to array of strings
287:    Output Parameter:
288: .  t - the copied array string
290:    Level: intermediate
292:    Note:
293:       Not for use in Fortran
295:   Concepts: string copy
297: .seealso: PetscStrallocpy() PetscStrArrayDestroy()
299: @*/
300: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
301: {
303:   PetscInt       i;
306:   PetscMalloc1(n,t);
307:   for (i=0; i<n; i++) {
308:     PetscStrallocpy(list[i],(*t)+i);
309:   }
310:   return(0);
311: }
315: /*@C
316:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
318:    Not Collective
320:    Output Parameters:
321: +   n - number of string entries
322: -   list - array of strings
324:    Level: intermediate
326:    Notes: Not for use in Fortran
328: .seealso: PetscStrArrayallocpy()
330: @*/
331: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
332: {
334:   PetscInt       i;
337:   if (!*list) return(0);
338:   for (i=0; i<n; i++){
339:     PetscFree((*list)[i]);
340:   }
341:   PetscFree(*list);
342:   return(0);
343: }
347: /*@C
348:    PetscStrcpy - Copies a string
350:    Not Collective
352:    Input Parameters:
353: .  t - pointer to string
355:    Output Parameter:
356: .  s - the copied string
358:    Level: intermediate
360:    Notes:
361:      Null string returns a string starting with zero
363:      Not for use in Fortran
365:   Concepts: string copy
367: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()
369: @*/
371: PetscErrorCode  PetscStrcpy(char s[],const char t[])
372: {
374:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
375:   if (t) strcpy(s,t);
376:   else if (s) s[0] = 0;
377:   return(0);
378: }
382: /*@C
383:    PetscStrncpy - Copies a string up to a certain length
385:    Not Collective
387:    Input Parameters:
388: +  t - pointer to string
389: -  n - the length to copy
391:    Output Parameter:
392: .  s - the copied string
394:    Level: intermediate
396:    Note:
397:      Null string returns a string starting with zero
399:      If the string that is being copied is of length n or larger then the entire string is not
400:      copied and the file location of s is set to NULL. This is different then the behavior of 
401:      strncpy() which leaves s non-terminated.
403:   Concepts: string copy
405: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
407: @*/
408: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
409: {
411:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
412:   if (t) {
413:     if (n > 1) {
414:       strncpy(s,t,n-1);
415:       s[n-1] = '\0';
416:     } else {
417:       s[0] = '\0';
418:     }
419:   } else if (s) s[0] = 0;
420:   return(0);
421: }
425: /*@C
426:    PetscStrcat - Concatenates a string onto a given string
428:    Not Collective
430:    Input Parameters:
431: +  s - string to be added to
432: -  t - pointer to string to be added to end
434:    Level: intermediate
436:    Notes: Not for use in Fortran
438:   Concepts: string copy
440: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
442: @*/
443: PetscErrorCode  PetscStrcat(char s[],const char t[])
444: {
446:   if (!t) return(0);
447:   strcat(s,t);
448:   return(0);
449: }
453: /*@C
454:    PetscStrncat - Concatenates a string onto a given string, up to a given length
456:    Not Collective
458:    Input Parameters:
459: +  s - pointer to string to be added to end
460: .  t - string to be added to
461: .  n - maximum length to copy
463:    Level: intermediate
465:   Notes:    Not for use in Fortran
467:   Concepts: string copy
469: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
471: @*/
472: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
473: {
475:   strncat(s,t,n);
476:   return(0);
477: }
481: /*
484:    Will be removed once we eliminate the __FUNCT__ paradigm
485: */
486: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
487: {
488:   int c;
490:   if (!a && !b)      *flg = PETSC_TRUE;
491:   else if (!a || !b) *flg = PETSC_FALSE;
492:   else {
493:     c = strcmp(a,b);
494:     if (c) *flg = PETSC_FALSE;
495:     else   *flg = PETSC_TRUE;
496:   }
497: }
501: /*@C
502:    PetscStrcmp - Compares two strings,
504:    Not Collective
506:    Input Parameters:
507: +  a - pointer to string first string
508: -  b - pointer to second string
510:    Output Parameter:
511: .  flg - PETSC_TRUE if the two strings are equal
513:    Level: intermediate
515:    Notes:    Not for use in Fortran
517: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
519: @*/
520: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
521: {
522:   int c;
525:   if (!a && !b)      *flg = PETSC_TRUE;
526:   else if (!a || !b) *flg = PETSC_FALSE;
527:   else {
528:     c = strcmp(a,b);
529:     if (c) *flg = PETSC_FALSE;
530:     else   *flg = PETSC_TRUE;
531:   }
532:   return(0);
533: }
537: /*@C
538:    PetscStrgrt - If first string is greater than the second
540:    Not Collective
542:    Input Parameters:
543: +  a - pointer to first string
544: -  b - pointer to second string
546:    Output Parameter:
547: .  flg - if the first string is greater
549:    Notes:
550:     Null arguments are ok, a null string is considered smaller than
551:     all others
553:    Not for use in Fortran
555:    Level: intermediate
557: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
559: @*/
560: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
561: {
562:   int c;
565:   if (!a && !b) *t = PETSC_FALSE;
566:   else if (a && !b) *t = PETSC_TRUE;
567:   else if (!a && b) *t = PETSC_FALSE;
568:   else {
569:     c = strcmp(a,b);
570:     if (c > 0) *t = PETSC_TRUE;
571:     else       *t = PETSC_FALSE;
572:   }
573:   return(0);
574: }
578: /*@C
579:    PetscStrcasecmp - Returns true if the two strings are the same
580:      except possibly for case.
582:    Not Collective
584:    Input Parameters:
585: +  a - pointer to first string
586: -  b - pointer to second string
588:    Output Parameter:
589: .  flg - if the two strings are the same
591:    Notes:
592:     Null arguments are ok
594:    Not for use in Fortran
596:    Level: intermediate
598: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
600: @*/
601: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
602: {
603:   int c;
606:   if (!a && !b) c = 0;
607:   else if (!a || !b) c = 1;
608: #if defined(PETSC_HAVE_STRCASECMP)
609:   else c = strcasecmp(a,b);
610: #elif defined(PETSC_HAVE_STRICMP)
611:   else c = stricmp(a,b);
612: #else
613:   else {
614:     char           *aa,*bb;
616:     PetscStrallocpy(a,&aa);
617:     PetscStrallocpy(b,&bb);
618:     PetscStrtolower(aa);
619:     PetscStrtolower(bb);
620:     PetscStrcmp(aa,bb,t);
621:     PetscFree(aa);
622:     PetscFree(bb);
623:     return(0);
624:   }
625: #endif
626:   if (!c) *t = PETSC_TRUE;
627:   else    *t = PETSC_FALSE;
628:   return(0);
629: }
635: /*@C
636:    PetscStrncmp - Compares two strings, up to a certain length
638:    Not Collective
640:    Input Parameters:
641: +  a - pointer to first string
642: .  b - pointer to second string
643: -  n - length to compare up to
645:    Output Parameter:
646: .  t - if the two strings are equal
648:    Level: intermediate
650:    Notes:    Not for use in Fortran
652: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
654: @*/
655: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
656: {
657:   int c;
660:   c = strncmp(a,b,n);
661:   if (!c) *t = PETSC_TRUE;
662:   else    *t = PETSC_FALSE;
663:   return(0);
664: }
668: /*@C
669:    PetscStrchr - Locates first occurance of a character in a string
671:    Not Collective
673:    Input Parameters:
674: +  a - pointer to string
675: -  b - character
677:    Output Parameter:
678: .  c - location of occurance, NULL if not found
680:    Level: intermediate
682:    Notes:    Not for use in Fortran
684: @*/
685: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
686: {
688:   *c = (char*)strchr(a,b);
689:   return(0);
690: }
694: /*@C
695:    PetscStrrchr - Locates one location past the last occurance of a character in a string,
696:       if the character is not found then returns entire string
698:    Not Collective
700:    Input Parameters:
701: +  a - pointer to string
702: -  b - character
704:    Output Parameter:
705: .  tmp - location of occurance, a if not found
707:    Level: intermediate
709:    Notes:    Not for use in Fortran
711: @*/
712: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
713: {
715:   *tmp = (char*)strrchr(a,b);
716:   if (!*tmp) *tmp = (char*)a;
717:   else *tmp = *tmp + 1;
718:   return(0);
719: }
723: /*@C
724:    PetscStrtolower - Converts string to lower case
726:    Not Collective
728:    Input Parameters:
729: .  a - pointer to string
731:    Level: intermediate
733:    Notes:    Not for use in Fortran
735: @*/
736: PetscErrorCode  PetscStrtolower(char a[])
737: {
739:   while (*a) {
740:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
741:     a++;
742:   }
743:   return(0);
744: }
748: /*@C
749:    PetscStrtolower - Converts string to upper case
751:    Not Collective
753:    Input Parameters:
754: .  a - pointer to string
756:    Level: intermediate
758:    Notes:    Not for use in Fortran
760: @*/
761: PetscErrorCode  PetscStrtoupper(char a[])
762: {
764:   while (*a) {
765:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
766:     a++;
767:   }
768:   return(0);
769: }
773: /*@C
774:    PetscStrendswith - Determines if a string ends with a certain string
776:    Not Collective
778:    Input Parameters:
779: +  a - pointer to string
780: -  b - string to endwith
782:    Output Parameter:
783: .  flg - PETSC_TRUE or PETSC_FALSE
785:    Notes:     Not for use in Fortran
787:    Level: intermediate
789: @*/
790: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
791: {
792:   char           *test;
794:   size_t         na,nb;
797:   *flg = PETSC_FALSE;
798:   PetscStrrstr(a,b,&test);
799:   if (test) {
800:     PetscStrlen(a,&na);
801:     PetscStrlen(b,&nb);
802:     if (a+na-nb == test) *flg = PETSC_TRUE;
803:   }
804:   return(0);
805: }
809: /*@C
810:    PetscStrbeginswith - Determines if a string begins with a certain string
812:    Not Collective
814:    Input Parameters:
815: +  a - pointer to string
816: -  b - string to beginwith
818:    Output Parameter:
819: .  flg - PETSC_TRUE or PETSC_FALSE
821:    Notes:     Not for use in Fortran
823:    Level: intermediate
825: @*/
826: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
827: {
828:   char           *test;
832:   *flg = PETSC_FALSE;
833:   PetscStrrstr(a,b,&test);
834:   if (test && (test == a)) *flg = PETSC_TRUE;
835:   return(0);
836: }
841: /*@C
842:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
844:    Not Collective
846:    Input Parameters:
847: +  a - pointer to string
848: -  bs - strings to endwith (last entry must be null)
850:    Output Parameter:
851: .  cnt - the index of the string it ends with or 1+the last possible index
853:    Notes:     Not for use in Fortran
855:    Level: intermediate
857: @*/
858: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
859: {
860:   PetscBool      flg;
864:   *cnt = 0;
865:   while (bs[*cnt]) {
866:     PetscStrendswith(a,bs[*cnt],&flg);
867:     if (flg) return(0);
868:     *cnt += 1;
869:   }
870:   return(0);
871: }
875: /*@C
876:    PetscStrrstr - Locates last occurance of string in another string
878:    Not Collective
880:    Input Parameters:
881: +  a - pointer to string
882: -  b - string to find
884:    Output Parameter:
885: .  tmp - location of occurance
887:    Notes:     Not for use in Fortran
889:    Level: intermediate
891: @*/
892: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
893: {
894:   const char *stmp = a, *ltmp = 0;
897:   while (stmp) {
898:     stmp = (char*)strstr(stmp,b);
899:     if (stmp) {ltmp = stmp;stmp++;}
900:   }
901:   *tmp = (char*)ltmp;
902:   return(0);
903: }
907: /*@C
908:    PetscStrstr - Locates first occurance of string in another string
910:    Not Collective
912:    Input Parameters:
913: +  haystack - string to search
914: -  needle - string to find
916:    Output Parameter:
917: .  tmp - location of occurance, is a NULL if the string is not found
919:    Notes: Not for use in Fortran
921:    Level: intermediate
923: @*/
924: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
925: {
927:   *tmp = (char*)strstr(haystack,needle);
928:   return(0);
929: }
931: struct _p_PetscToken {char token;char *array;char *current;};
935: /*@C
936:    PetscTokenFind - Locates next "token" in a string
938:    Not Collective
940:    Input Parameters:
941: .  a - pointer to token
943:    Output Parameter:
944: .  result - location of occurance, NULL if not found
946:    Notes:
948:      This version is different from the system version in that
949:   it allows you to pass a read-only string into the function.
951:      This version also treats all characters etc. inside a double quote "
952:    as a single token.
954:      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 
955:    second will return a null terminated y
957:      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
959:     Not for use in Fortran
961:    Level: intermediate
964: .seealso: PetscTokenCreate(), PetscTokenDestroy()
965: @*/
966: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
967: {
968:   char *ptr = a->current,token;
971:   *result = a->current;
972:   if (ptr && !*ptr) {*result = 0;return(0);}
973:   token = a->token;
974:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
975:   while (ptr) {
976:     if (*ptr == token) {
977:       *ptr++ = 0;
978:       while (*ptr == a->token) ptr++;
979:       a->current = ptr;
980:       break;
981:     }
982:     if (!*ptr) {
983:       a->current = 0;
984:       break;
985:     }
986:     ptr++;
987:   }
988:   return(0);
989: }
993: /*@C
994:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
996:    Not Collective
998:    Input Parameters:
999: +  string - the string to look in
1000: -  b - the separator character
1002:    Output Parameter:
1003: .  t- the token object
1005:    Notes:
1007:      This version is different from the system version in that
1008:   it allows you to pass a read-only string into the function.
1010:     Not for use in Fortran
1012:    Level: intermediate
1014: .seealso: PetscTokenFind(), PetscTokenDestroy()
1015: @*/
1016: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
1017: {
1021:   PetscNew(t);
1022:   PetscStrallocpy(a,&(*t)->array);
1024:   (*t)->current = (*t)->array;
1025:   (*t)->token   = b;
1026:   return(0);
1027: }
1031: /*@C
1032:    PetscTokenDestroy - Destroys a PetscToken
1034:    Not Collective
1036:    Input Parameters:
1037: .  a - pointer to token
1039:    Level: intermediate
1041:    Notes:     Not for use in Fortran
1043: .seealso: PetscTokenCreate(), PetscTokenFind()
1044: @*/
1045: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1046: {
1050:   if (!*a) return(0);
1051:   PetscFree((*a)->array);
1052:   PetscFree(*a);
1053:   return(0);
1054: }
1059: /*@C
1060:    PetscGetPetscDir - Gets the directory PETSc is installed in
1062:    Not Collective
1064:    Output Parameter:
1065: .  dir - the directory
1067:    Level: developer
1069:    Notes: Not for use in Fortran
1071: @*/
1072: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1073: {
1075:   *dir = PETSC_DIR;
1076:   return(0);
1077: }
1081: /*@C
1082:    PetscStrreplace - Replaces substrings in string with other substrings
1084:    Not Collective
1086:    Input Parameters:
1087: +   comm - MPI_Comm of processors that are processing the string
1088: .   aa - the string to look in
1089: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1090: -   len - the length of b
1092:    Notes:
1093:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1094:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1095:       as well as any environmental variables.
1097:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1098:       PETSc was built with and do not use environmental variables.
1100:       Not for use in Fortran
1102:    Level: intermediate
1104: @*/
1105: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1106: {
1108:   int            i = 0;
1109:   size_t         l,l1,l2,l3;
1110:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1111:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1112:   const char     *r[] = {0,0,0,0,0,0,0,0,0};
1113:   PetscBool      flag;
1116:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1117:   if (aa == b) {
1118:     PetscStrallocpy(aa,(char**)&a);
1119:   }
1120:   PetscMalloc1(len,&work);
1122:   /* get values for replaced variables */
1123:   PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1124:   PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1125:   PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1126:   PetscMalloc1(256,&r[3]);
1127:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1128:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1129:   PetscMalloc1(256,&r[6]);
1130:   PetscMalloc1(256,&r[7]);
1131:   PetscGetDisplay((char*)r[3],256);
1132:   PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1133:   PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1134:   PetscGetUserName((char*)r[6],256);
1135:   PetscGetHostName((char*)r[7],256);
1137:   /* replace that are in environment */
1138:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1139:   if (flag) {
1140:     PetscFree(r[2]);
1141:     PetscStrallocpy(env,(char**)&r[2]);
1142:   }
1144:   /* replace the requested strings */
1145:   PetscStrncpy(b,a,len);
1146:   while (s[i]) {
1147:     PetscStrlen(s[i],&l);
1148:     PetscStrstr(b,s[i],&par);
1149:     while (par) {
1150:       *par =  0;
1151:       par += l;
1153:       PetscStrlen(b,&l1);
1154:       PetscStrlen(r[i],&l2);
1155:       PetscStrlen(par,&l3);
1156:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1157:       PetscStrcpy(work,b);
1158:       PetscStrcat(work,r[i]);
1159:       PetscStrcat(work,par);
1160:       PetscStrncpy(b,work,len);
1161:       PetscStrstr(b,s[i],&par);
1162:     }
1163:     i++;
1164:   }
1165:   i = 0;
1166:   while (r[i]) {
1167:     tfree = (char*)r[i];
1168:     PetscFree(tfree);
1169:     i++;
1170:   }
1172:   /* look for any other ${xxx} strings to replace from environmental variables */
1173:   PetscStrstr(b,"${",&par);
1174:   while (par) {
1175:     *par  = 0;
1176:     par  += 2;
1177:     PetscStrcpy(work,b);
1178:     PetscStrstr(par,"}",&epar);
1179:     *epar = 0;
1180:     epar += 1;
1181:     PetscOptionsGetenv(comm,par,env,256,&flag);
1182:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1183:     PetscStrcat(work,env);
1184:     PetscStrcat(work,epar);
1185:     PetscStrcpy(b,work);
1186:     PetscStrstr(b,"${",&par);
1187:   }
1188:   PetscFree(work);
1189:   if (aa == b) {
1190:     PetscFree(a);
1191:   }
1192:   return(0);
1193: }
1197: /*@C
1198:    PetscEListFind - searches list of strings for given string, using case insensitive matching
1200:    Not Collective
1202:    Input Parameters:
1203: +  n - number of strings in
1204: .  list - list of strings to search
1205: -  str - string to look for, empty string "" accepts default (first entry in list)
1207:    Output Parameters:
1208: +  value - index of matching string (if found)
1209: -  found - boolean indicating whether string was found (can be NULL)
1211:    Notes:
1212:    Not for use in Fortran
1214:    Level: advanced
1215: @*/
1216: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1217: {
1219:   PetscBool matched;
1220:   PetscInt i;
1223:   if (found) *found = PETSC_FALSE;
1224:   for (i=0; i<n; i++) {
1225:     PetscStrcasecmp(str,list[i],&matched);
1226:     if (matched || !str[0]) {
1227:       if (found) *found = PETSC_TRUE;
1228:       *value = i;
1229:       break;
1230:     }
1231:   }
1232:   return(0);
1233: }
1237: /*@C
1238:    PetscEListFind - searches enum list of strings for given string, using case insensitive matching
1240:    Not Collective
1242:    Input Parameters:
1243: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1244: -  str - string to look for
1246:    Output Parameters:
1247: +  value - index of matching string (if found)
1248: -  found - boolean indicating whether string was found (can be NULL)
1250:    Notes:
1251:    Not for use in Fortran
1253:    Level: advanced
1254: @*/
1255: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1256: {
1258:   PetscInt n = 0,evalue;
1259:   PetscBool efound;
1262:   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");
1263:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1264:   n -= 3; /* drop enum name, prefix, and null termination */
1265:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1266:   if (efound) *value = (PetscEnum)evalue;
1267:   if (found) *found = efound;
1268:   return(0);
1269: }