libf2c/libF77/getenv_.c

   1 #include "f2c.h"
   2 #undef abs
   3 #include <stdlib.h>
   4 #include <string.h>
   5 extern char *F77_aloc (ftnlen, char *);
   6
   7 /*
   8  * getenv - f77 subroutine to return environment variables
   9  *
  10  * called by:
  11  *      call getenv (ENV_NAME, char_var)
  12  * where:
  13  *      ENV_NAME is the name of an environment variable
  14  *      char_var is a character variable which will receive
  15  *              the current value of ENV_NAME, or all blanks
  16  *              if ENV_NAME is not defined
  17  */
  18
  19 void
  20 G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
  21 {
  22   char buf[256], *ep, *fp;
  23   integer i;
  24
  25   if (flen <= 0)
  26     goto add_blanks;
  27   for (i = 0; i < (integer) sizeof (buf); i++)
  28     {
  29       if (i == flen || (buf[i] = fname[i]) == ' ')
  30         {
  31           buf[i] = 0;
  32           ep = getenv (buf);
  33           goto have_ep;
  34         }
  35     }
  36   while (i < flen && fname[i] != ' ')
  37     i++;
  38   strncpy (fp = F77_aloc (i + 1, "getenv_"), fname, (int) i);
  39   fp[i] = 0;
  40   ep = getenv (fp);
  41   free (fp);
  42 have_ep:
  43   if (ep)
  44     while (*ep && vlen-- > 0)
  45       *value++ = *ep++;
  46 add_blanks:
  47   while (vlen-- > 0)
  48     *value++ = ' ';
  49 }