Actual source code: str.c

petsc-master 2016-05-25
Report Typos and Errors
  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: }