コード例 #1
0
int
BasicGFunEvaluator::uParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName)
{
  // this is deprecated but keep in there for now
	
  // match regular expressions of known lsf parameters
  char* pattern = {"(ud*)\\(([0-9]+),([0-9]+)\\)"};
  const char* first;
  const char* last;
  char par_result[30];
	
  // save instances of parameters
  Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern);
  if (regexp == NULL) {
    opserr << "GFunEvaluator::uParse ERROR compiling regular expression -- " << pattern << endln;
    opserr << theTclInterp->result << endln;
  }
	
  if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) {
    // match found
		
    // get var name
    Tcl_RegExpRange(regexp, 1, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      strcpy(varName, par_result);
      
      if ( strncmp(par_result, "udd", 3) == 0 )
	strcpy(disp,"accel");
      
      else if ( strncmp(par_result, "ud", 2) == 0 )
	strcpy(disp,"vel");
      
      else if ( strncmp(par_result, "u", 1) == 0 )
	strcpy(disp,"disp");
      
    }
    
    // get node number
    Tcl_RegExpRange(regexp, 2, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      *node = atoi(par_result);
    }
    
    // get direction
    Tcl_RegExpRange(regexp, 3, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      *dirn = atoi(par_result);
    }
    
    sprintf(arrName,"%d,%d",*node,*dirn);
  } 
  
  return 0;
}
コード例 #2
0
int
BasicGFunEvaluator::nodeParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName)
{
  // match regular expressions of known lsf parameters
  char* pattern = {"((rec_)?node)\\(([0-9]+),([0-9]+),([a-z]+)\\)"};
  const char* first;
  const char* last;
  char par_result[30];
  
  // save instances of parameters
  Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern);
  if (regexp == NULL) {
    opserr << "GFunEvaluator::nodeParse ERROR compiling regular expression -- " << pattern << endln;
    opserr << theTclInterp->result << endln;
  }
  
  if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) {
    // match found
    
    // get var name
    Tcl_RegExpRange(regexp, 1, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      strcpy(varName, par_result);
    }
    
    // get node number
    Tcl_RegExpRange(regexp, 3, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      *node = atoi(par_result);
    }
    
    // get direction
    Tcl_RegExpRange(regexp, 4, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      *dirn = atoi(par_result);
    }
    
    // get response type
    Tcl_RegExpRange(regexp, 5, &first, &last);
    if (first) {
      strncpy(par_result,first,last-first);
      par_result[last-first] = '\0';
      strcpy(disp, par_result);
    }
    
    sprintf(arrName,"%d,%d,%s",*node,*dirn,disp);
  } 
  
  return 0;
}
コード例 #3
0
ファイル: tclRegexp.c プロジェクト: afmayer/tcl-tk
int
Tcl_RegExpMatch(
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    const char *text,		/* Text to search for pattern matches. */
    const char *pattern)	/* Regular expression to match against text. */
{
    Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern);

    if (re == NULL) {
	return -1;
    }
    return Tcl_RegExpExec(interp, re, text, text);
}
コード例 #4
0
ファイル: test.c プロジェクト: Tommy17/benchmarks
// modifed from: http://shootout.alioth.debian.org/u32/program.php?test=regexdna&lang=gcc&id=1
int main(int argc, char *argv[])
{
	char *buf, *q;
	int l = 0;
	Tcl_RegExp r;

	if (argc == 1) {
		fprintf(stderr, "Usage: cat in.file | %s <regexp>\n", argv[0]);
		return 0;
	}
	Tcl_FindExecutable(argv[0]);
	r = Tcl_RegExpCompile(0, argv[1]);
	buf = calloc(BUF_SIZE, 1);
	while (fgets(buf, BUF_SIZE - 1, stdin)) {
		++l;
		for (q = buf; *q; ++q); if (q > buf) *--q = 0;
		if (Tcl_RegExpExec(0, r, buf, 0))
			printf("%d:%s\n", l, buf);
	}
	free(buf);
	return 0;
}
コード例 #5
0
int
LimitStateFunction::tokenizeIt(const char *originalExpression)
{
	// Can automatically convert Terje's {} stuff to proper Tcl syntax
	// in this method, e.g., {x_1} --> \$x(1) and {u_5_2} --> \[nodeDisp 5 2]
	//
	// implementation of any new patterns needs to also be reflected in gfunction and sensitivity algorithm

	char separators[] = "}{";
	int deprecated = strcspn(originalExpression, separators);
	int originalLen = strlen(originalExpression);
	
	if (deprecated < originalLen) {
		opserr << "WARNING: Limit state function " << this->getTag() << " contains OLD syntax "
				<< "that uses {x_1}, {u_1_1}, {file_fileName_1_1}, etc. " << endln;
		opserr << "Use new Tcl variable syntax \\$x(1), \\$u(1,1), etc." << endln << endln;
		opserr << "Just a note (from KRM) about the deprecated LSF syntax:\n"
				<< "you can still use RVs in your LSF, however, they are now specified directly:\n"
				<< "	{x_2}  -->  \\$xrv(2)\n"
				<< "if you feel really nostalgic, you can still write the following:\n"
				<< "	{x_2}  -->  \\$x_2\n"
				<< "however the second option will go away at some point.\n" << endln
				<< "Nodal commands now work as follows:\n"
				<< "	{u_1_2}  -->  \\$u(1,2)\n"
				<< "	{u_1_2}  -->  \\[nodeDisp 1 2]\n"
				<< "	{u_1_2}  -->  \\$node(1,2,disp) or \\$rec_node(1,2,disp)\n"
				<< "	{ud_1_2} -->  \\$rec_node(1,2,vel) or \\$ud(1,2)\n"
				<< "	etc., etc.\n" << endln
				<< "Element forces can be defined in the same way and are element dependent:\n"
				<< "	\\$element(2,localForce_1) would give you column 1 of ele 2 localForce\n"
				<< "	\\$rec_element(1,section_2_force_1), etc, etc.\n" << endln
				<< "Also, the code in this file also allowed reading of values from a file.\n"
				<< "This too can be implemented more directly by the user simply by using \n"
				<< "standard Tcl variables.  ie., instead of computing a value, writing it \n"
				<< "to a file, and then using file_fileName_1_2 or whatever, now:\n"
				<< "	{file_fileName_1_2}  -->  \\$yourTclVariable\n" << endln
				<< "Limit state function parameters can now be specified and used, both for \n"
				<< "sensitivity studies, and for parametricReliabilityAnalysis:\n"
				<< "	{par_1}  -->  \\$par(1)\n" << endln
				<< "And a final note, if a particular GFunEvaluator is still obsessed with\n"
				<< "case-specific LSF arguments, they can still be implemented through \n"
				<< "the tokenizeSpecials() function. However, they must be specified in \n"
				<< "standard Tcl syntax and the values initialized in your own script.\n" << endln
				<< "If you are using DDM, the \\[nodeDisp 1 2] or similar commands will not \n"
				<< "work because there is no way to perturb these to calculate dg/du. So \n"
				<< "if you are doing DDM, use the \\$u(1,2), \\$ud(1,2), etc syntax.  For \n"
				<< "DDM, you can also use element forces (if sensitivities are coded).\n" << endln;
		exit(-1);
	}
	
	// now match regular expressions of known lsf parameters
	// Note: lsf parameters are not the same as the Parameter class in OS domain.
	const int numberOfParamTypes = 5;
	char* pattern[numberOfParamTypes] = {"x(_|rv\\()[0-9]+\\)?",
										 "ud*\\([0-9]+,[0-9]+\\)",
										 "(rec_)?node\\([0-9]+,[0-9]+,[a-z]+\\)",
										 "(rec_)?element\\([0-9]+,[a-zA-Z0-9_]+\\)",
										 "par\\([0-9]+\\)"};
	const char* first;
	const char* last;
	char par_result[30];
	
	// initialize the tcl list object
	paramList = Tcl_NewListObj(0,NULL);
	
	// cycle through pattern types and save instances of parameters to tcl list object
	for (int ireg = 0; ireg < numberOfParamTypes; ireg++) {
		Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern[ireg]);
		if (regexp == NULL) {
			opserr << "LSF::tokenizeIt ERROR compiling regular expression -- " << pattern[ireg] << endln;
			opserr << theTclInterp->result << endln;
		}
		
		char* current = new char[originalLen+1];
		strcpy(current,originalExpression);
			
		while ( Tcl_RegExpExec(theTclInterp, regexp, current, current) == 1 ) {
			// match found
			Tcl_RegExpRange(regexp, 0, &first, &last);
			
			if (first) {
				strncpy(par_result,first,last-first);
				par_result[last-first] = '\0';
				
				//opserr << "Found: " << par_result << endln;
				Tcl_Obj *tempStr = Tcl_NewStringObj(par_result,last-first);
				//opserr << Tcl_GetStringFromObj(tempStr,NULL) << endln;
				
				if (Tcl_ListObjAppendElement(theTclInterp, paramList, tempStr) != TCL_OK) {
					opserr << "LSF::tokenizeIt ERROR creating list element from " << par_result << endln;
					opserr << theTclInterp->result << endln;
				}
			}
			
			strcpy(current, last);
		} 
			
		delete [] current;
	}
	
	//Tcl_IncrRefCount(paramList);
		
	return 0;
}
コード例 #6
0
int	cmdSetPath(	ClientData	 client_data,
	       		Tcl_Interp	*interp,
	       		int		 argc,
	       		CONST84 char	*argv[])
{
    Tcl_RegExp	chkexpPtr;			/** Regular expression for   **/
						/** marker checking	     **/
    char	 *oldpath,			/** Old value of 'var'	     **/
		 *newpath,			/** New value of 'var'	     **/
		 *sw_marker = APP_SW_MARKER,	/** arbitrary default	     **/
		 *startp=NULL, *endp=NULL,	/** regexp match endpts	     **/
		 *qualifiedpath,		/** List of dirs which 
						    aren't already in path   **/
		**pathlist;			/** List of dirs	     **/
    const char	 *delim = _colon;		/** path delimiter	     **/
    int		  append = 1,			/** append or prepend	     **/
		  numpaths,			/** number of dirs in path   **/
		  qpathlen,			/** qualifiedpath length     **/
		  arg1 = 1,			/** arg start		     **/
		  x;				/** loop index		     **/

#if WITH_DEBUGGING_CALLBACK
    ErrorLogger( NO_ERR_START, LOC, _proc_cmdSetPath, NULL);
#endif

    /**
     **  Whatis mode?
     **/
    if( g_flags & (M_WHATIS | M_HELP))
        goto success0;
	
    /**
     **   Check arguments. There should be at least 3 args:
     **     argv[0]  -  prepend/append
     **     ...
     **     argv[n-1]-  varname
     **     argv[n]  -  value
     **/
    if(argc < 3)
	if( OK != ErrorLogger(ERR_USAGE, LOC, argv[0],
	    " path-variable directory", NULL))
	    goto unwind0;

    /**
     **  Should this guy be removed from the variable ... If yes, do so!
     **/
    if(g_flags & M_REMOVE) 
	return( cmdRemovePath(client_data, interp, argc, argv));   /** ----> **/

    /**
     **  prepend or append. The default is append.
     **/
    if( !( append = !!strncmp( argv[0], "pre", 3)))
	sw_marker = PRE_SW_MARKER;
  
    /**
     **  Non-persist mode?
     **/
    
    if (g_flags & M_NONPERSIST) {
	return (TCL_OK);
    }

    /**
     **  Display only ... ok, let's do so!
     **/
    if(g_flags & M_DISPLAY) {
	fprintf( stderr, "%s\t ", argv[ 0]);
	while( --argc)
	    fprintf( stderr, "%s ", *++argv);
	fprintf( stderr, "\n");
        goto success0;
    }

    /**
     **  Check for the delimiter option
     **/
    if(*(argv[arg1]) == '-') {
	if (!strcmp(argv[arg1], "-d")) {
		delim = argv[arg1+1];
		arg1 += 2;
	} else if (!strcmp(argv[arg1], "--delim")) {
		delim = argv[arg1+1];
		arg1 += 2;
	} else if (!strncmp(argv[arg1], "--delim=", 8)) {
		delim = argv[arg1]+8;
		arg1++;
	}
    }

    /**
     **  Get the old value of the variable. MANPATH defaults to a configure
     **  generated value.
     **  Put a \ in front of each '.' and '+'.
     **  (this is an intentional memory leak)
     **/
    oldpath =  EMGetEnv( interp, argv[arg1]);
    _TCLCHK(interp)

    if(!oldpath || !*oldpath) {
	null_free((void *) &oldpath);
	oldpath = !strcmp( argv[arg1], "MANPATH")
		? stringer(NULL,0,DEFAULTMANPATH,NULL)
		: stringer(NULL,0,"",NULL);
    }

    /**
     **  Split the new path into its components directories so each
     **  directory can be checked to see whether it is already in the 
     **  existing path.
     **/
    if( !( pathlist = SplitIntoList( interp, (char *) argv[arg1+1], &numpaths,
	delim)))
	goto unwind0;

    /**
     **  Some space for the list of paths which
     **  are not already in the existing path.
     **/
    if((char *) NULL == (qualifiedpath = stringer(NULL,0, argv[arg1+1],
	delim, NULL)))
	if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
	    goto unwind1;

    qpathlen = strlen(qualifiedpath)+1;
    *qualifiedpath = '\0';		/** make sure null for later	     **/

    for( x = 0; x < numpaths; x++) {

	regex_quote( pathlist[x], buffer, PATH_BUFLEN);

	/**
	 **  Check to see if path is already in this path variable.
	 **  It could be at the 
	 **     beginning ... ^path:
	 **     middle    ... :path:
	 **     end       ... :path$
	 **     only one  ... ^path$
	 **/
	if((char *) NULL == (newpath = stringer(NULL,0,
		"(^", buffer, delim, ")|(",delim, buffer, delim,")|(",delim,
		buffer, "$)|(^", buffer, "$)",NULL)))
	    if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
		goto unwind2;

	chkexpPtr = Tcl_RegExpCompile(interp, newpath);
	_TCLCHK(interp)
	null_free((void *) &newpath);

	/**
	 **  If the directory is not already in the path, 
	 **  add it to the qualified path.
	 **/
	if( !Tcl_RegExpExec(interp, chkexpPtr, oldpath, oldpath))
	    if (!stringer(qualifiedpath + strlen(qualifiedpath),
		    qpathlen - strlen(qualifiedpath),
		    pathlist[x], delim, NULL))
		if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
		    goto unwind2;

    }					/** End of loop that checks for 
					 ** already existent path
					 **/
    /**
     **  If all of the directories in the new path already exist,
     **  exit doing nothing.
     **/
    if( ! *qualifiedpath)
	goto success1;

    /* remove trailing delimiter */
    qualifiedpath[strlen(qualifiedpath) - 1] = '\0';

    /**
     **  Some space for our newly created path.
     **  We size at the oldpath plus the addition.
     **/
    if(!(newpath = stringer(NULL, strlen( oldpath) +
	strlen(qualifiedpath) + 2,NULL)))
	if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
	    goto unwind2;
    *newpath = '\0';

    /**
     **  Easy job to do, if the old path has not been set up so far ...
     **/
    if( !strcmp( oldpath, "")) {
	strcpy( newpath, qualifiedpath);

    /**
     **  Otherwise we have to take care on prepending vs. appending ...
     **  If there is a append or prepend marker within the variable (see
     **  modules_def.h) the changes are made according to this markers. Other-
     **  wise append and prepend will be relative to the strings begin or end.
     **/

    } else {

	Tcl_RegExp	markexpPtr = Tcl_RegExpCompile(interp, sw_marker);
	_TCLCHK(interp)

	strcpy( newpath, oldpath);

	if( Tcl_RegExpExec(interp, markexpPtr, oldpath, oldpath)) {
	    _TCLCHK(interp)
	    Tcl_RegExpRange(markexpPtr, 0,
		(CONST84 char **) &startp, (CONST84 char **) &endp);

	    /**
	     **  Append/Prepend marker found
	     **/
	    if( append) {
		char ch = *startp;
		*startp = '\0';
		strcpy(newpath, oldpath);
                /**
                 ** check that newpath has a value before adding delim
                 **/
		if (strlen(newpath) > 0 && newpath[strlen(newpath)-1] != *delim)
			strcat(newpath, delim);
		strcat(newpath, qualifiedpath);
		if (newpath[strlen(newpath)-1] != *delim)
			strcat(newpath, delim);
		*startp = ch;
		strcat(newpath, startp);
               
	    } else {
                char ch = *endp;
		*endp = '\0';
		strcpy(newpath, oldpath);
		if (newpath[strlen(newpath)-1] != *delim)
			strcat(newpath, delim);
		strcat(newpath, qualifiedpath);
		*endp = ch;
		strcat(newpath, endp);
	    }

	} else {

	    /**
	     **  No marker set
	     **/
	    if(append) {
		strcpy(newpath, oldpath);
		if (newpath[strlen(newpath)-1] != *delim)
			strcat(newpath, delim);
		strcat(newpath, qualifiedpath);
	    } else {
		strcpy(newpath, qualifiedpath);
		if (*oldpath != *delim)	strcat(newpath, delim);
		strcat(newpath, oldpath);
	    }

	} /** if( marker) **/

    } /** if( strcmp) **/

    /**
     **  Now the new value to be set resides in 'newpath'. Set it up.
     **/
    moduleSetenv( interp, (char *) argv[arg1], newpath, 1);
    _TCLCHK(interp)

#if WITH_DEBUGGING_CALLBACK
    ErrorLogger( NO_ERR_END, LOC, _proc_cmdSetPath, NULL);
#endif

    /**
     ** Free resources
     **/
    null_free((void *) &newpath);
success1:
    null_free((void *) &oldpath);
    null_free((void *) &qualifiedpath);
    FreeList( pathlist, numpaths);
success0:
    return( TCL_OK);			/** -------- EXIT (SUCCESS) -------> **/

unwind2:
    null_free((void *) &qualifiedpath);
unwind1:
    FreeList( pathlist, numpaths);
unwind0:
    null_free((void *) &oldpath);
    return( TCL_ERROR);			/** -------- EXIT (FAILURE) -------> **/

} /** End of 'cmdSetPath' **/