int mers1Getenv( int usemsg, const char * param, int *status ) {
char envvar[32]; /* environment variable name */
char *c; /* pointer to character in name */
char *val; /* environ value */
int retval = -1;
long result = 0;
if (*status != SAI__OK) return retval;
/* copy prefix and param into the buffer */
if (usemsg) {
star_strlcpy( envvar, "MSG_", sizeof(envvar) );
} else {
star_strlcpy( envvar, "ERR_", sizeof(envvar) );
}
star_strlcat( envvar, param, sizeof(envvar) );
/* upper case it */
c = envvar;
while ( *c ) {
*c = toupper(*c);
c++;
}
/* Query the environment */
val = getenv( envvar );
if (val) {
/* Convert to an integer */
char *endptr = NULL;
result = strtol( val, &endptr, 10 );
if (result == 0 && endptr == val) {
if (usemsg) {
*status = MSG__BDENV;
emsSetc( "SYS", "msgTune");
} else {
*status = ERR__BDENV;
emsSetc( "SYS", "errTune");
}
emsSetc( "EV", envvar );
emsSetc( "VAL", val );
emsRep( "MERS_TUNE_BDENV",
"^SYS: Failed to convert environment variable "
"^EV (^VAL) to integer", status );
} else {
retval = result;
}
}
return retval;
}
void
dat1emsSetBigi( const char * token, INT_BIG value )
{
/* simplest approach is to format the number our selves and then
store that using emsSetc */
char buffer[BUFSIZE];
int nfmt;
nfmt = snprintf(buffer, BUFSIZE, "%" HDS_INT_BIG_S, value );
if (nfmt < BUFSIZE) emsSetc( token, buffer );
return;
}
/* Function Definitons: */
void emsErrno( const char *token, int errval ){
char mess[EMS__SZTOK+1]; /* Message associated with errval */
TRACE("emsErrno");
/* Call EMS1_SERR */
ems1Serr( mess, EMS__SZTOK, &errval );
mess[EMS__SZTOK] = '\0';
/* Check for a good translation */
if ( strspn(mess," ") != EMS__SZTOK ){
/* OK - put the mesage in a token */
emsSetc( token, mess);
} else {
/* Bad - construct an error message */
emsSetc( token, "No translation for errno");
emsSetc( token, " ");
emsSeti( token, errval );
}
return;
}
int datUnlock( HDSLoc *locator, int recurs, int *status ) {
/* Local variables; */
Handle *error_handle = NULL;
int lstat;
const char *phrase;
/* Check inherited status. */
if (*status != SAI__OK) return *status;
/* Validate input locator. */
dat1ValidateLocator( "datUnlock", 0, locator, 0, status );
/* Check we can de-reference "locator" safely. */
if( *status == SAI__OK ) {
/* Attempt to unlock the specified object, plus all its components if
required. Report suitable errors if this fails. */
error_handle = dat1HandleLock( locator->handle, 3, recurs, 0, &lstat,
status );
if( *status == SAI__OK && lstat < 1 ) {
*status = DAT__THREAD;
datMsg( "O", locator );
emsRep( " ", "datUnlock: Cannot unlock HDS object '^O' for "
"use by the current thread:", status );
if( lstat < 0 ) {
phrase = "currently locked for writing by a different thread";
} else {
phrase = "not currently locked by the current thread";
}
emsSetc( "P", phrase );
dat1HandleMsg( "E", error_handle );
if( error_handle != locator->handle ) {
emsRep( " ", "A component within it (^E) is ^P.", status );
} else {
emsRep( " ", "It is ^P.", status );
}
}
}
return *status;
}
void datMsg( const char * token, const HDSLoc * loc ) {
/* Local Variables: */
char buff[EMS__SZMSG+EMS__SZMSG+2]; /* Buffer for file+path */
char file[EMS__SZMSG+1]; /* Container file name */
char path[EMS__SZMSG+1]; /* Object path name */
char *bra; /* Position of '(' character */
char *dot; /* Position of '.' */
size_t ncf; /* Number of characters in filename */
int nlev; /* Object level in HDS */
#if defined( vms )
char *semi; /* Position of ';' */
#endif
char *start; /* Position to start in path name */
int status = DAT__OK; /* local status variable */
int odd; /* Is the filename odd? */
int ok; /* No error occurred? */
/* Mark the error stack */
emsMark();
/* Obtain the data object path and container file name. */
hdsTrace( loc, &nlev, path, file, &status, sizeof(path), sizeof(file) );
if ( status == DAT__OK ) {
/* If necessary, handle VAX/VMS file names. Locate the semicolon which
* delimits the version number in the file name. */
#if defined( vms )
semi = strchr( file, ';' );
/* If found, then select the file name prior to it by replacing
it with a nul. */
if (semi != NULL ) {
*semi = '\0';
}
#endif
/* Find the filename length */
ncf = strlen( file );
/* See if the file is "odd". Check to see if it has the default file
* extension of '.SDF' with at least one character preceding it. */
odd = 1;
if ( ncf >= 5 ) {
if ( strcmp( &file[ncf-DAT__SZFLX], DAT__FLEXT ) == 0) {
odd = 0;
} else {
odd = 1;
}
}
/* If the file name is not odd, then omit the file extension. */
if (!odd) file[ncf-DAT__SZFLX] = '\0';
/* Enter the file name into the buffer, surrounding it in quotes if it
* is odd. */
*buff = '\0';
if (odd) strcat(buff, "\"" );
strcat( buff, file );
if (odd) strcat(buff, "\"" );
/* If the object is not a top-level object, then find the position of
* the first '.' in its pathname, which marks the start of the first
* component name. */
if (nlev > 1 ) {
dot = strchr( path, '.' );
/* If successful, see if the '.' is preceded by a '(' indicating that
* the top-level object is subscripted. Derive the starting position in
* the path name so that the subscript is used if present. */
if (dot != NULL) {
bra = strchr( path, '(' );
if (bra != NULL && bra < dot) {
start = bra;
} else {
start = dot;
}
/* Add the required part of the path name to the buffer. */
strcat( buff, start );
}
} else {
/* If the object is a top-level object, then see if it is subscripted.
* If so, then add the subscript to the buffer. */
start = strchr( path, '(' );
if ( start != NULL ) {
strcat( buff, start );
}
}
}
/* Note if any error has occurred. */
ok = ( status == DAT__OK ? 1 : 0 );
/* If an error occurred, then annul it. Release the error stack. */
if ( status != DAT__OK ) emsAnnul( &status );
emsRlse();
/* If no error occurred, then assign the resulting buffer contents to
* the message token. */
if (ok) emsSetc( token, buff );
}
int datRef( const HDSLoc * locator, char * ref, size_t reflen, int * status ) {
/* Local Variables: */
char buff[MAX_PATH_LEN+1]; /* Buffer */
char file[MAX_PATH_LEN+1]; /* Container file name */
char path[MAX_PATH_LEN+1]; /* Object path name */
char *bra; /* Position of '(' character */
char *dot; /* Position of '.' */
size_t ncf; /* Number of characters in filename */
int i; /* Loop counter */
int nlev; /* Object level in HDS */
#if defined( vms )
char *semi; /* Position of ';' */
#endif
char *start; /* Position to start in path name */
int add_dot; /* Do we need to add a '.' ? */
int odd; /* Is the filename odd? */
/* Terminate the buffer so that it is safe*/
*ref = '\0';
/* Check intial global status */
if ( *status != DAT__OK ) return *status;
/* Obtain the data object path and container file name. */
/* Lie about the size of the supplied buffer to account for quotes
and dots that may be added */
hdsTrace( locator, &nlev, path, file, status, MAX_PATH_LEN-3, MAX_PATH_LEN-1 );
if ( *status == DAT__OK ) {
/* If necessary, handle VAX/VMS file names. Locate the semicolon which
* delimits the version number in the file name. */
#if defined( vms )
semi = strchr( file, ';' );
/* If found, then select the file name prior to it by replacing
it with a nul. */
if (semi != NULL ) {
*semi = '\0';
}
#endif
/* Find the filename length */
ncf = strlen( file );
/* See if the file is "odd". Check to see if it has the default file
* extension of '.SDF' with at least one character preceding it. */
odd = 1;
if ( ncf >= 5 ) {
if ( strcmp( &file[ncf-DAT__SZFLX], DAT__FLEXT) == 0) {
odd = 0;
} else {
odd = 1;
}
}
/* If the file name is odd, then we must also decide whether to append
* a '.' to the end of it. This is done to counteract the removal of a
* terminating '.' which HDS performs on all Unix file names (to permit
* the creation of files without a '.' in their names if required).
* Initially assume an extra '.' is needed.
*/
if (odd) {
add_dot = 1;
/* If the file name already ends with a '.'. then another '.' will be
* needed to protect it. Otherwise, search backwards through the final
* field of the file name (stopping when a '/' is encountered) to see
* whether there is already a '.' present.
*/
if ( file[ncf-1] != '.' ) {
/* search back through the string */
for ( i = 1; i <= ncf ; i++ ) {
if ( file[ncf-i] == '/' ) break;
/* If a '.' is present, then note that another one need not be added
* (otherwise one must be added to prevent the default ".sdf" extension
* being appended if HDS re-opens the file using this name).
*/
if ( file[ncf-i] == '.' ) {
add_dot = 0;
break;
}
}
/* If an extra '.' is needed, then append it to the file name (note
* that an extra character is reserved in FILE for this purpose).
*/
if (add_dot) {
strcat( file, "." );
}
}
}
/* If the file name is not odd, then omit the file extension. */
if (!odd) file[ncf-4] = '\0';
/* Enter the file name into the buffer, surrounding it in quotes if it
* is odd. */
*buff = '\0';
if (odd) strcat(buff, "\"" );
strcat( buff, file );
if (odd) strcat(buff, "\"" );
/* If the object is not a top-level object, then find the position of
* the first '.' in its pathname, which marks the start of the first
* component name. */
if (nlev > 1 ) {
dot = strchr( path, '.' );
/* If successful, see if the '.' is preceded by a '(' indicating that
* the top-level object is subscripted. Derive the starting position in
* the path name so that the subscript is used if present. */
if (dot != NULL) {
bra = strchr( path, '(' );
if (bra != NULL && bra < dot) {
start = bra;
} else {
start = dot;
}
/* Add the required part of the path name to the buffer. */
strcat( buff, start );
}
} else {
/* If the object is a top-level object, then see if it is subscripted.
* If so, then add the subscript to the buffer. */
start = strchr( path, '(' );
if ( start != NULL ) {
strcat( buff, start );
}
}
/* If the length of the reference name exceeded the length of the output
* argument, then append an ellipsis.
*/
if ( strlen(buff) > reflen -1 ) {
strncpy( ref, buff, reflen - 4 );
ref[reflen-4] = '\0';
strcat(ref, "xyz");
/* Report an error showing the truncated character string */
*status = DAT__TRUNC;
emsSetc( "STRING", ref );
emsRep( "DAT_REF_1",
"Character string truncated: '^STRING'.",
status );
emsRep( "DAT_REF_2",
"Output character variable is too short "
"to accommodate the returned result.",
status );
} else {
strcpy( ref, buff );
}
}
/* If an error occurred report contextual information */
if ( *status != DAT__OK ) {
emsRep( "DAT_REF_ERR",
"DAT_REF: Error obtaining a reference name "
"for an HDS object.", status );
}
return *status;
}
int main (void) {
/* Local Variables: */
const char path[] = "hds_ctest";
int status = DAT__OK;
hdsdim dim[] = { 10, 20 };
hdsdim dimd[1];
const char * chararr[] = { "TEST1", "TEST2", "Longish String" };
char *retchararr[4];
char buffer[1024]; /* plenty large enough */
double darr[] = { 4.5, 2.5 };
double retdarr[2];
void *mapv; /* Mapped void* */
double *mapd; /* Mapped _DOUBLE */
float *mapf; /* Mapped _REAL */
int *mapi; /* Mapped _INTEGER */
int64_t *mapi64; /* Mapped _INT64 */
HDSLoc * loc1 = NULL;
HDSLoc * loc2 = NULL;
HDSLoc * loc3 = NULL;
size_t actval;
size_t nel;
size_t nelt;
size_t nbytes;
size_t i;
int n;
double sumd;
int sumi;
int64_t sumi64;
int64_t test64;
int64_t testin64;
const int64_t VAL__BADK = (-9223372036854775807 - 1);
emsBegin(&status);
/* Force 64-bit mode */
hdsTune( "64BIT", 1, &status );
/* Create a new container file */
hdsNew( path, "HDS_TEST", "NDF", 0, dim, &loc1, &status );
/* Some components */
datNew( loc1, "DATA_ARRAY", "_INTEGER", 2, dim, &status );
datNew1C( loc1, "ONEDCHAR", 14, 3, &status );
datNew1D( loc1, "ONEDD", 2, &status );
datNew0K( loc1, "TESTI64", &status );
datNew0K( loc1, "TESTBADI64", &status );
/* Populate */
testin64 = 9223372036854775800;
datFind( loc1, "TESTI64", &loc2, &status );
datPut0K( loc2, testin64, &status );
datGet0K( loc2, &test64, &status );
datAnnul( &loc2, &status );
if (status == DAT__OK) {
if ( test64 != testin64 ) {
status = DAT__FATAL;
emsRepf( "TESTI64", "Test _INT64 value %" PRIi64 " did not match expected %"PRIi64,
&status, test64, testin64 );
}
}
datFind( loc1, "TESTBADI64", &loc2, &status );
datPut0K( loc2, VAL__BADK, &status );
datGet0K( loc2, &test64, &status );
datAnnul( &loc2, &status );
if (status == DAT__OK) {
if ( test64 != VAL__BADK ) {
status = DAT__FATAL;
emsRepf( "TESTBADI64", "Test _INT64 value %" PRIi64 " did not match expected VAL__BADK",
&status, test64 );
}
}
datFind( loc1, "ONEDCHAR", &loc2, &status );
datPutVC( loc2, 3, chararr, &status );
/* Check contents */
datGetVC(loc2, 3, 1024, buffer, retchararr, &actval, &status);
if (status == DAT__OK) {
if (actval == 3) {
for (i = 0; i < 3; i++ ) {
if (strncmp( chararr[i], retchararr[i], strlen(chararr[i]) ) ) {
status = DAT__DIMIN;
emsSetc( "IN", chararr[i]);
emsSetc( "OUT", retchararr[i] );
emsRep( "GET1C","Values from Get1C differ (^IN != ^OUT)", &status);
break;
}
}
} else {
status = DAT__DIMIN;
emsRep( "GET1C","Did not get back as many strings as put in", &status);
}
}
datAnnul( &loc2, &status );
datFind( loc1, "ONEDD", &loc2, &status );
datPutVD( loc2, 2, darr, &status );
/* Check contents */
datGetVD( loc2, 2, retdarr, &actval, &status);
if (status == DAT__OK) {
if (actval == 2) {
for (i = 0; i < 2; i++ ) {
if (darr[i] != retdarr[i]) {
status = DAT__DIMIN;
emsRep( "GETVD","Values from getVD differ", &status);
break;
}
}
} else {
status = DAT__DIMIN;
emsRep( "GETVD","Did not get back as many values as put in", &status);
}
}
/* Try mapping - _DOUBLE */
dimd[0] = 2;
datMapD(loc2, "READ", 1, dimd, &mapd, &status);
if (status == DAT__OK) {
for (i = 0; i < 2; i++ ) {
if (darr[i] != mapd[i]) {
status = DAT__DIMIN;
emsRep( "MAPD","Values from MapD differ", &status);
break;
}
}
}
datUnmap(loc2, &status);
/* Try mapping - _FLOAT */
datMapR(loc2, "READ", 1, dimd, &mapf, &status);
if (status == DAT__OK) {
for (i = 0; i < 2; i++ ) {
if ( (float)darr[i] != mapf[i]) {
status = DAT__DIMIN;
emsRep( "MAPR","Values from MapR differ", &status);
break;
}
}
}
datUnmap(loc2, &status);
/* Annul */
datAnnul( &loc2, &status );
/* Find and map DATA_ARRAY */
datFind( loc1, "DATA_ARRAY", &loc2, &status );
datMapV( loc2, "_REAL", "WRITE", &mapv, &nel, &status );
mapf = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumd = 0.0;
for (i = 1; i <= nel; i++) {
mapf[i-1] = (float)i;
sumd += (double)i;
}
datUnmap( loc2, &status );
datAnnul( &loc2, &status );
hdsClose( &loc1, &status );
/* Re-open */
hdsOpen( path, "UPDATE", &loc1, &status );
/* Look for the data array and map it */
datFind( loc1, "DATA_ARRAY", &loc2, &status );
datVec( loc2, &loc3, &status );
datSize( loc3, &nel, &status);
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements before (^NORI) not the same as now (^NEL)", &status);
}
}
datPrec( loc3, &nbytes, &status );
if (status == DAT__OK) {
if ( nbytes != 4) {
status = DAT__FATAL;
emsSeti( "NB", nbytes );
emsRep( "PREC","Precision for _REAL not 4 bytes but ^NB", &status);
}
}
/* Try hdsShow */
hdsShow("LOCATORS", &status);
hdsShow("FILES", &status);
hdsInfoI(NULL, "LOCATORS", "!HDS_TEST.,YYY", &n, &status );
hdsInfoI(NULL, "FILES", NULL, &n, &status );
datAnnul( &loc3, &status );
datMapV( loc2, "_INTEGER", "READ", &mapv, &nel, &status );
mapi = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumi = 0;
for (i = 0; i < nel; i++) {
sumi += mapi[i];
}
datUnmap( loc2, &status );
if (status == DAT__OK) {
if (sumi != (int)sumd) {
status = DAT__FATAL;
emsSeti( "I", sumi );
emsSeti( "D", (int)sumd );
emsRep("SUM","Sum was not correct. Got ^I rather than ^D", &status );
}
}
/* _INT64 test */
datMapV( loc2, "_INT64", "READ", &mapv, &nel, &status );
mapi64 = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumi64 = 0;
for (i = 0; i < nel; i++) {
sumi64 += mapi64[i];
}
datUnmap( loc2, &status );
if (status == DAT__OK) {
if (sumi64 != (int)sumd) {
status = DAT__FATAL;
emsSeti( "I", (int)sumi64 );
emsSeti( "D", (int)sumd );
emsRep("SUM","Sum was not correct. Got ^I rather than ^D", &status );
}
}
/* Tidy up and close */
hdsErase( &loc1, &status );
if (status == DAT__OK) {
printf("HDS C installation test succeeded\n");
emsEnd(&status);
return EXIT_SUCCESS;
} else {
printf("HDS C installation test failed\n");
emsEnd(&status);
return EXIT_FAILURE;
}
}
void errTune( const char * param, int value, int * status ) {
const char * parnames[] = { "SZOUT", "STREAM", "REVEAL", NULL };
const char * thispar = NULL; /* Selected parameter */
int i;
int set; /* Value has been set */
int istat = SAI__OK; /* Internal status */
int env = 0; /* Are we using the environment? */
int npars = 0; /* Number of parameters to read */
int useval = 0; /* Tuning value to actually use */
int envval; /* Tuning value from environment */
int fromenv = 0; /* Value came from environment */
int ltune; /* Actual tuning value used */
/* Check for 'ENVIRONMENT' */
if (strcasecmp( param, "ENVIRONMENT" ) == 0) {
env = 1;
/* work it out ourselves */
npars = 0;
while ( parnames[npars] ) {
npars++;
}
} else {
env = 0;
npars = 1;
thispar = param;
}
/* Now for each required parameter */
i = 0;
while ( istat == SAI__OK && i < npars) {
/* Select next par name if we are in env mode */
if (env) {
thispar = parnames[i];
set = 0;
} else {
set = 1;
}
i++;
/* See if the associated environment variable is set
* If so, override the given VALUE - make sure we do not
* clear tokens by starting a new context. */
emsMark();
fromenv = 0;
envval = mers1Getenv( 0, thispar, &istat );
emsRlse();
if (envval == -1) {
/* everything okay but no environment variable */
useval = value;
} else if (envval > 0 ) {
set = 1;
useval = envval;
fromenv = 1;
}
if (istat == SAI__OK && set) {
ltune = -1;
/* Check that the given parameter name is acceptable
* and handle it. */
if (strcasecmp( "SZOUT", thispar) == 0) {
if (useval == 0) {
ltune = ERR__SZMSG;
} else if ( useval > 6 ) {
ltune = MIN( useval, ERR__SZMSG );
} else {
istat = ERR__BTUNE;
}
if (ltune != -1) {
err1Ptwsz( ltune );
}
} else if (strcasecmp( "STREAM", thispar) == 0 ) {
if (useval == 0) {
ltune = 0;
} else if (useval == 1) {
ltune = 1;
} else {
istat = ERR__BTUNE;
}
if (ltune != -1) err1Ptstm( ltune );
} else if (strcasecmp( "REVEAL", thispar ) == 0 ) {
if (useval == 0) {
ltune = 0;
} else if (useval == 1) {
ltune = 1;
} else {
istat = ERR__BTUNE;
}
if (ltune != -1) {
emsTune( "REVEAL", ltune, &istat );
err1Ptrvl( ltune );
}
} else {
/* The given tuning parameter was not in the available set.
* Set status and report an error message.
* We mark and rlse to prevent possible token name clash */
emsMark();
istat = ERR__BDPAR;
emsSetc( "PARAM", thispar );
emsRep( "ERR_TUNE_PAR",
"errTune: Invalid tuning parameter: ^PARAM", &istat );
emsRlse();
}
if (istat == ERR__BTUNE) {
/* The given tuning parameter value was invalid
* Report an error message
* We mark and rlse to prevent posible token name clash */
emsMark();
emsSetc( "PARAM", thispar );
emsSeti( "VALUE", useval );
if (fromenv) {
emsSetc( "SOURCE", "from environment variable" );
} else {
emsSetc( "SOURCE", " " );
}
emsRep( "ERR_TUNE_INV",
"errTune: ^PARAM invalid value ^VALUE ^SOURCE", &istat);
emsRlse();
}
}
}
/* Set return status */
if (*status == SAI__OK) *status = istat;
}
