libgfortran/intrinsics/args.c

   1 /* Implementation of the GETARG and IARGC g77, and
   2    corresponding F2003, intrinsics.
   3    Copyright (C) 2004, 2005, 2007, 2009, 2010
   4    Free Software Foundation, Inc.
   5    Contributed by Bud Davis and Janne Blomqvist.
   6
   7 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   8
   9 Libgfortran is free software; you can redistribute it and/or
  10 modify it under the terms of the GNU General Public
  11 License as published by the Free Software Foundation; either
  12 version 3 of the License, or (at your option) any later version.
  13
  14 Libgfortran is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 Under Section 7 of GPL version 3, you are granted additional
  20 permissions described in the GCC Runtime Library Exception, version
  21 3.1, as published by the Free Software Foundation.
  22
  23 You should have received a copy of the GNU General Public License and
  24 a copy of the GCC Runtime Library Exception along with this program;
  25 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  26 <http://www.gnu.org/licenses/>.  */
  27
  28 #include "libgfortran.h"
  29 #include <string.h>
  30
  31
  32 /* Get a commandline argument.  */
  33
  34 extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type);
  35 iexport_proto(getarg_i4);
  36
  37 void
  38 getarg_i4 (GFC_INTEGER_4 *pos, char  *val, gfc_charlen_type val_len)
  39 {
  40   int argc;
  41   int arglen;
  42   char **argv;
  43
  44   get_args (&argc, &argv);
  45
  46   if (val_len < 1 || !val )
  47     return;   /* something is wrong , leave immediately */
  48
  49   memset (val, ' ', val_len);
  50
  51   if ((*pos) + 1 <= argc  && *pos >=0 )
  52     {
  53       arglen = strlen (argv[*pos]);
  54       if (arglen > val_len)
  55         arglen = val_len;
  56       memcpy (val, argv[*pos], arglen);
  57     }
  58 }
  59 iexport(getarg_i4);
  60
  61
  62 /* INTEGER*8 wrapper of getarg.  */
  63
  64 extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type);
  65 export_proto (getarg_i8);
  66
  67 void
  68 getarg_i8 (GFC_INTEGER_8 *pos, char  *val, gfc_charlen_type val_len)
  69 {
  70   GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos;
  71   getarg_i4 (&pos4, val, val_len);
  72 }
  73
  74
  75 /* Return the number of commandline arguments.  The g77 info page
  76    states that iargc does not include the specification of the
  77    program name itself.  */
  78
  79 extern GFC_INTEGER_4 iargc (void);
  80 export_proto(iargc);
  81
  82 GFC_INTEGER_4
  83 iargc (void)
  84 {
  85   int argc;
  86   char **argv;
  87
  88   get_args (&argc, &argv);
  89
  90   return (argc - 1);
  91 }
  92
  93
  94 /* F2003 intrinsic functions and subroutines related to command line
  95    arguments.
  96
  97    - function command_argument_count() is converted to iargc by the compiler.
  98
  99    - subroutine get_command([command, length, status]).
 100
 101    - subroutine get_command_argument(number, [value, length, status]).
 102 */
 103
 104 /* These two status codes are specified in the standard. */
 105 #define GFC_GC_SUCCESS 0
 106 #define GFC_GC_VALUE_TOO_SHORT -1
 107
 108 /* Processor-specific status failure code. */
 109 #define GFC_GC_FAILURE 42
 110
 111
 112 extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *,
 113                                      GFC_INTEGER_4 *, gfc_charlen_type);
 114 iexport_proto(get_command_argument_i4);
 115
 116 /* Get a single commandline argument.  */
 117
 118 void
 119 get_command_argument_i4 (GFC_INTEGER_4 *number, char *value,
 120                          GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 121                          gfc_charlen_type value_len)
 122 {
 123   int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS;
 124   char **argv;
 125
 126   if (number == NULL )
 127     /* Should never happen.  */
 128     runtime_error ("Missing argument to get_command_argument");
 129
 130   if (value == NULL && length == NULL && status == NULL)
 131     return; /* No need to do anything.  */
 132
 133   get_args (&argc, &argv);
 134
 135   if (*number < 0 || *number >= argc)
 136     stat_flag = GFC_GC_FAILURE;
 137   else
 138     arglen = strlen(argv[*number]);
 139
 140   if (value != NULL)
 141     {
 142       if (value_len < 1)
 143         stat_flag = GFC_GC_FAILURE;
 144       else
 145         memset (value, ' ', value_len);
 146     }
 147
 148   if (value != NULL && stat_flag != GFC_GC_FAILURE)
 149     {
 150       if (arglen > value_len)
 151          stat_flag = GFC_GC_VALUE_TOO_SHORT;
 152
 153       memcpy (value, argv[*number], arglen <= value_len ? arglen : value_len);
 154     }
 155
 156   if (length != NULL)
 157     *length = arglen;
 158
 159   if (status != NULL)
 160     *status = stat_flag;
 161 }
 162 iexport(get_command_argument_i4);
 163
 164
 165 /* INTEGER*8 wrapper for get_command_argument.  */
 166
 167 extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *,
 168                                      GFC_INTEGER_8 *, gfc_charlen_type);
 169 export_proto(get_command_argument_i8);
 170
 171 void
 172 get_command_argument_i8 (GFC_INTEGER_8 *number, char *value,
 173                          GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 174                          gfc_charlen_type value_len)
 175 {
 176   GFC_INTEGER_4 number4;
 177   GFC_INTEGER_4 length4;
 178   GFC_INTEGER_4 status4;
 179
 180   number4 = (GFC_INTEGER_4) *number;
 181   get_command_argument_i4 (&number4, value, &length4, &status4, value_len);
 182   if (length)
 183     *length = length4;
 184   if (status)
 185     *status = status4;
 186 }
 187
 188
 189 /* Return the whole commandline.  */
 190
 191 extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
 192                             gfc_charlen_type);
 193 iexport_proto(get_command_i4);
 194
 195 void
 196 get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status,
 197                 gfc_charlen_type command_len)
 198 {
 199   int i, argc, arglen, thisarg;
 200   int stat_flag = GFC_GC_SUCCESS;
 201   int tot_len = 0;
 202   char **argv;
 203
 204   if (command == NULL && length == NULL && status == NULL)
 205     return; /* No need to do anything.  */
 206
 207   get_args (&argc, &argv);
 208
 209   if (command != NULL)
 210     {
 211       /* Initialize the string to blanks.  */
 212       if (command_len < 1)
 213         stat_flag = GFC_GC_FAILURE;
 214       else
 215         memset (command, ' ', command_len);
 216     }
 217
 218   for (i = 0; i < argc ; i++)
 219     {
 220       arglen = strlen(argv[i]);
 221
 222       if (command != NULL && stat_flag == GFC_GC_SUCCESS)
 223         {
 224           thisarg = arglen;
 225           if (tot_len + thisarg > command_len)
 226             {
 227               thisarg = command_len - tot_len; /* Truncate.  */
 228               stat_flag = GFC_GC_VALUE_TOO_SHORT;
 229             }
 230           /* Also a space before the next arg.  */
 231           else if (i != argc - 1 && tot_len + arglen == command_len)
 232             stat_flag = GFC_GC_VALUE_TOO_SHORT;
 233
 234           memcpy (&command[tot_len], argv[i], thisarg);
 235         }
 236
 237       /* Add the legth of the argument.  */
 238       tot_len += arglen;
 239       if (i != argc - 1)
 240         tot_len++;
 241     }
 242
 243   if (length != NULL)
 244     *length = tot_len;
 245
 246   if (status != NULL)
 247     *status = stat_flag;
 248 }
 249 iexport(get_command_i4);
 250
 251
 252 /* INTEGER*8 wrapper for get_command.  */
 253
 254 extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *,
 255                             gfc_charlen_type);
 256 export_proto(get_command_i8);
 257
 258 void
 259 get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status,
 260                 gfc_charlen_type command_len)
 261 {
 262   GFC_INTEGER_4 length4;
 263   GFC_INTEGER_4 status4;
 264
 265   get_command_i4 (command, &length4, &status4, command_len);
 266   if (length)
 267     *length = length4;
 268   if (status)
 269     *status = status4;
 270 }