#include "config.h"
#include <sys/types.h>
#include <stdlib.h>
#include <string.h>
#include "libgfortran.h"
void PREFIX(getenv) (char *, char *, gfc_charlen_type, gfc_charlen_type);
export_proto_np(PREFIX(getenv));
void
PREFIX(getenv) (char * name, char * value, gfc_charlen_type name_len,
gfc_charlen_type value_len)
{
char *name_nt;
char *res = NULL;
int res_len;
if (name == NULL || value == NULL)
runtime_error ("Both arguments to getenv are mandatory.");
if (value_len < 1 || name_len < 1)
runtime_error ("Zero length string(s) passed to getenv.");
else
memset (value, ' ', value_len);
while (name_len > 0 && name[name_len - 1] == ' ')
name_len--;
name_nt = gfc_alloca (name_len + 1);
memcpy (name_nt, name, name_len);
name_nt[name_len] = '\0';
res = getenv(name_nt);
if (res == NULL)
return;
res_len = strlen(res);
if (value_len < res_len)
memcpy (value, res, value_len);
else
memcpy (value, res, res_len);
}
#define GFC_SUCCESS 0
#define GFC_VALUE_TOO_SHORT -1
#define GFC_NAME_DOES_NOT_EXIST 1
#define GFC_NOT_SUPPORTED 2
#define GFC_FAILURE 42
extern void get_environment_variable_i4 (char *, char *, GFC_INTEGER_4 *,
GFC_INTEGER_4 *, GFC_LOGICAL_4 *,
gfc_charlen_type, gfc_charlen_type);
iexport_proto(get_environment_variable_i4);
void
get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length,
GFC_INTEGER_4 *status, GFC_LOGICAL_4 *trim_name,
gfc_charlen_type name_len,
gfc_charlen_type value_len)
{
int stat = GFC_SUCCESS, res_len = 0;
char *name_nt;
char *res;
if (name == NULL)
runtime_error ("Name is required for get_environment_variable.");
if (value == NULL && length == NULL && status == NULL && trim_name == NULL)
return;
if (name_len < 1)
runtime_error ("Zero-length string passed as name to "
"get_environment_variable.");
if (value != NULL)
{
if (value_len < 1)
runtime_error ("Zero-length string passed as value to "
"get_environment_variable.");
else
memset (value, ' ', value_len);
}
if ((!trim_name) || *trim_name)
{
while (name_len > 0 && name[name_len - 1] == ' ')
name_len--;
}
name_nt = gfc_alloca (name_len + 1);
memcpy (name_nt, name, name_len);
name_nt[name_len] = '\0';
res = getenv(name_nt);
if (res == NULL)
stat = GFC_NAME_DOES_NOT_EXIST;
else
{
res_len = strlen(res);
if (value != NULL)
{
if (value_len < res_len)
{
memcpy (value, res, value_len);
stat = GFC_VALUE_TOO_SHORT;
}
else
memcpy (value, res, res_len);
}
}
if (status != NULL)
*status = stat;
if (length != NULL)
*length = res_len;
}
iexport(get_environment_variable_i4);
extern void get_environment_variable_i8 (char *, char *, GFC_INTEGER_8 *,
GFC_INTEGER_8 *, GFC_LOGICAL_8 *,
gfc_charlen_type, gfc_charlen_type);
export_proto(get_environment_variable_i8);
void
get_environment_variable_i8 (char *name, char *value, GFC_INTEGER_8 *length,
GFC_INTEGER_8 *status, GFC_LOGICAL_8 *trim_name,
gfc_charlen_type name_len,
gfc_charlen_type value_len)
{
GFC_INTEGER_4 length4, status4;
GFC_LOGICAL_4 trim_name4;
if (trim_name)
trim_name4 = *trim_name;
get_environment_variable_i4 (name, value, &length4, &status4,
&trim_name4, name_len, value_len);
if (length)
*length = length4;
if (status)
*status = status4;
}