[thirdparty/gcc.git] / libgfortran / io / inquire.c

/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010
   Free Software Foundation, Inc.
   Contributed by Andy Vaught

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */


/* Implement the non-IOLENGTH variant of the INQUIRY statement */

#include "io.h"
#include "unix.h"
#include <string.h>


static const char undefined[] = "UNDEFINED";


/* inquire_via_unit()-- Inquiry via unit number.  The unit might not exist. */

static void
inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{
  const char *p;
  GFC_INTEGER_4 cf = iqp->common.flags;

  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
    {
      *iqp->exist = (iqp->common.unit >= 0
		     && iqp->common.unit <= GFC_INTEGER_4_HUGE);

      if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
	{
	  if (!(*iqp->exist))
	    *iqp->common.iostat = LIBERROR_BAD_UNIT;
	  *iqp->exist = *iqp->exist
			&& (*iqp->common.iostat != LIBERROR_BAD_UNIT);
	}
    }

  if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
    *iqp->opened = (u != NULL);

  if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
    *iqp->number = (u != NULL) ? u->unit_number : -1;

  if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
    *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);

  if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
      && u != NULL && u->flags.status != STATUS_SCRATCH)
    {
#ifdef HAVE_TTYNAME
      if (u->unit_number == options.stdin_unit
	  || u->unit_number == options.stdout_unit
	  || u->unit_number == options.stderr_unit)
	{
	  char * tmp = ttyname (((unix_stream *) u->s)->fd);
	  if (tmp != NULL)
	    {
	      int tmplen = strlen (tmp);
	      fstrcpy (iqp->name, iqp->name_len, tmp, tmplen);
	    }
	  else /* If ttyname does not work, go with the default.  */
	    fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
	}
      else
#endif
	fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
    }

  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
    {
      if (u == NULL)
	p = undefined;
      else
	switch (u->flags.access)
	  {
	  case ACCESS_SEQUENTIAL:
	    p = "SEQUENTIAL";
	    break;
	  case ACCESS_DIRECT:
	    p = "DIRECT";
	    break;
	  case ACCESS_STREAM:
	    p = "STREAM";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad access");
	  }

      cf_strcpy (iqp->access, iqp->access_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
    {
      if (u == NULL)
	p = inquire_sequential (NULL, 0);
      else
	switch (u->flags.access)
	  {
	  case ACCESS_DIRECT:
	  case ACCESS_STREAM:
	    p = "NO";
	    break;
	  case ACCESS_SEQUENTIAL:
	    p = "YES";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad access");
	  }

      cf_strcpy (iqp->sequential, iqp->sequential_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
    {
      if (u == NULL)
	p = inquire_direct (NULL, 0);
      else
	switch (u->flags.access)
	  {
	  case ACCESS_SEQUENTIAL:
	  case ACCESS_STREAM:
	    p = "NO";
	    break;
	  case ACCESS_DIRECT:
	    p = "YES";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad access");
	  }

      cf_strcpy (iqp->direct, iqp->direct_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
    {
      if (u == NULL)
	p = undefined;
      else
	switch (u->flags.form)
	  {
	  case FORM_FORMATTED:
	    p = "FORMATTED";
	    break;
	  case FORM_UNFORMATTED:
	    p = "UNFORMATTED";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad form");
	  }

      cf_strcpy (iqp->form, iqp->form_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
    {
      if (u == NULL)
	p = inquire_formatted (NULL, 0);
      else
	switch (u->flags.form)
	  {
	  case FORM_FORMATTED:
	    p = "YES";
	    break;
	  case FORM_UNFORMATTED:
	    p = "NO";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad form");
	  }

      cf_strcpy (iqp->formatted, iqp->formatted_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
    {
      if (u == NULL)
	p = inquire_unformatted (NULL, 0);
      else
	switch (u->flags.form)
	  {
	  case FORM_FORMATTED:
	    p = "NO";
	    break;
	  case FORM_UNFORMATTED:
	    p = "YES";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad form");
	  }

      cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
    *iqp->recl_out = (u != NULL) ? u->recl : 0;

  if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
    *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;

  if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
    {
      /* This only makes sense in the context of DIRECT access.  */
      if (u != NULL && u->flags.access == ACCESS_DIRECT)
	*iqp->nextrec = u->last_record + 1;
      else
	*iqp->nextrec = 0;
    }

  if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
    {
      if (u == NULL || u->flags.form != FORM_FORMATTED)
	p = undefined;
      else
	switch (u->flags.blank)
	  {
	  case BLANK_NULL:
	    p = "NULL";
	    break;
	  case BLANK_ZERO:
	    p = "ZERO";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
	  }

      cf_strcpy (iqp->blank, iqp->blank_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
    {
      if (u == NULL || u->flags.form != FORM_FORMATTED)
	p = undefined;
      else
	switch (u->flags.pad)
	  {
	  case PAD_YES:
	    p = "YES";
	    break;
	  case PAD_NO:
	    p = "NO";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
	  }

      cf_strcpy (iqp->pad, iqp->pad_len, p);
    }

  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
    {
      GFC_INTEGER_4 cf2 = iqp->flags2;

      if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
	*iqp->pending = 0;
  
      if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
        *iqp->id = 0;

      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
	{
	  if (u == NULL || u->flags.form != FORM_FORMATTED)
	    p = undefined;
          else
	    switch (u->flags.encoding)
	      {
	      case ENCODING_DEFAULT:
		p = "UNKNOWN";
		break;
	      case ENCODING_UTF8:
		p = "UTF-8";
		break;
	      default:
		internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
	      }

	  cf_strcpy (iqp->encoding, iqp->encoding_len, p);
	}

      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
	{
	  if (u == NULL || u->flags.form != FORM_FORMATTED)
	    p = undefined;
	  else
	    switch (u->flags.decimal)
	      {
	      case DECIMAL_POINT:
		p = "POINT";
		break;
	      case DECIMAL_COMMA:
		p = "COMMA";
		break;
	      default:
		internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
	      }

	  cf_strcpy (iqp->decimal, iqp->decimal_len, p);
	}

      if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
	{
	  if (u == NULL)
	    p = undefined;
	  else
	    switch (u->flags.async)
	    {
	      case ASYNC_YES:
		p = "YES";
		break;
	      case ASYNC_NO:
		p = "NO";
		break;
	      default:
		internal_error (&iqp->common, "inquire_via_unit(): Bad async");
	    }

	  cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
	}

      if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
	{
	  if (u == NULL)
	    p = undefined;
	  else
	    switch (u->flags.sign)
	    {
	      case SIGN_PROCDEFINED:
		p = "PROCESSOR_DEFINED";
		break;
	      case SIGN_SUPPRESS:
		p = "SUPPRESS";
		break;
	      case SIGN_PLUS:
		p = "PLUS";
		break;
	      default:
		internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
	    }

	  cf_strcpy (iqp->sign, iqp->sign_len, p);
	}

      if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
	{
	  if (u == NULL)
	    p = undefined;
	  else
	    switch (u->flags.round)
	    {
	      case ROUND_UP:
		p = "UP";
		break;
	      case ROUND_DOWN:
		p = "DOWN";
		break;
	      case ROUND_ZERO:
		p = "ZERO";
		break;
	      case ROUND_NEAREST:
		p = "NEAREST";
		break;
	      case ROUND_COMPATIBLE:
		p = "COMPATIBLE";
		break;
	      case ROUND_PROCDEFINED:
		p = "PROCESSOR_DEFINED";
		break;
	      default:
		internal_error (&iqp->common, "inquire_via_unit(): Bad round");
	    }

	  cf_strcpy (iqp->round, iqp->round_len, p);
	}

      if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
	{
	  if (u == NULL)
	    *iqp->size = -1;
	  else
	    *iqp->size = file_size (u->file, (gfc_charlen_type) u->file_len);
	}
    }

  if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
    {
      if (u == NULL || u->flags.access == ACCESS_DIRECT)
        p = undefined;
      else
        switch (u->flags.position)
          {
             case POSITION_REWIND:
               p = "REWIND";
               break;
             case POSITION_APPEND:
               p = "APPEND";
               break;
             case POSITION_ASIS:
               p = "ASIS";
               break;
             default:
               /* if not direct access, it must be
                  either REWIND, APPEND, or ASIS.
                  ASIS seems to be the best default */
               p = "ASIS";
               break;
          }
      cf_strcpy (iqp->position, iqp->position_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
    {
      if (u == NULL)
	p = undefined;
      else
	switch (u->flags.action)
	  {
	  case ACTION_READ:
	    p = "READ";
	    break;
	  case ACTION_WRITE:
	    p = "WRITE";
	    break;
	  case ACTION_READWRITE:
	    p = "READWRITE";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad action");
	  }

      cf_strcpy (iqp->action, iqp->action_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
    {
      p = (u == NULL) ? inquire_read (NULL, 0) :
	inquire_read (u->file, u->file_len);

      cf_strcpy (iqp->read, iqp->read_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
    {
      p = (u == NULL) ? inquire_write (NULL, 0) :
	inquire_write (u->file, u->file_len);

      cf_strcpy (iqp->write, iqp->write_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
    {
      p = (u == NULL) ? inquire_readwrite (NULL, 0) :
	inquire_readwrite (u->file, u->file_len);

      cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
    {
      if (u == NULL || u->flags.form != FORM_FORMATTED)
	p = undefined;
      else
	switch (u->flags.delim)
	  {
	  case DELIM_NONE:
	    p = "NONE";
	    break;
	  case DELIM_QUOTE:
	    p = "QUOTE";
	    break;
	  case DELIM_APOSTROPHE:
	    p = "APOSTROPHE";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
	  }

      cf_strcpy (iqp->delim, iqp->delim_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
    {
      if (u == NULL || u->flags.form != FORM_FORMATTED)
	p = undefined;
      else
	switch (u->flags.pad)
	  {
	  case PAD_NO:
	    p = "NO";
	    break;
	  case PAD_YES:
	    p = "YES";
	    break;
	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
	  }

      cf_strcpy (iqp->pad, iqp->pad_len, p);
    }
 
  if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
    {
      if (u == NULL)
	p = undefined;
      else
	switch (u->flags.convert)
	  {
	    /*  big_endian is 0 for little-endian, 1 for big-endian.  */
	  case GFC_CONVERT_NATIVE:
	    p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
	    break;

	  case GFC_CONVERT_SWAP:
	    p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
	    break;

	  default:
	    internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
	  }

      cf_strcpy (iqp->convert, iqp->convert_len, p);
    }
}


/* inquire_via_filename()-- Inquiry via filename.  This subroutine is
 * only used if the filename is *not* connected to a unit number. */

static void
inquire_via_filename (st_parameter_inquire *iqp)
{
  const char *p;
  GFC_INTEGER_4 cf = iqp->common.flags;

  if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
    *iqp->exist = file_exists (iqp->file, iqp->file_len);

  if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
    *iqp->opened = 0;

  if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
    *iqp->number = -1;

  if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
    *iqp->named = 1;

  if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
    fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);

  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
    cf_strcpy (iqp->access, iqp->access_len, undefined);

  if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
    {
      p = "UNKNOWN";
      cf_strcpy (iqp->sequential, iqp->sequential_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
    {
      p = "UNKNOWN";
      cf_strcpy (iqp->direct, iqp->direct_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
    cf_strcpy (iqp->form, iqp->form_len, undefined);

  if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
    {
      p = "UNKNOWN";
      cf_strcpy (iqp->formatted, iqp->formatted_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
    {
      p = "UNKNOWN";
      cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
    *iqp->recl_out = 0;

  if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
    *iqp->nextrec = 0;

  if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
    cf_strcpy (iqp->blank, iqp->blank_len, undefined);

  if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
    cf_strcpy (iqp->pad, iqp->pad_len, undefined);

  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
    {
      GFC_INTEGER_4 cf2 = iqp->flags2;

      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
  
      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
	cf_strcpy (iqp->delim, iqp->delim_len, undefined);

      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
	cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);

      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
	cf_strcpy (iqp->delim, iqp->delim_len, undefined);

      if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
	cf_strcpy (iqp->pad, iqp->pad_len, undefined);
  
      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);

      if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
	*iqp->size = file_size (iqp->file, iqp->file_len);
    }

  if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
    cf_strcpy (iqp->position, iqp->position_len, undefined);

  if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
    cf_strcpy (iqp->access, iqp->access_len, undefined);

  if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
    {
      p = inquire_read (iqp->file, iqp->file_len);
      cf_strcpy (iqp->read, iqp->read_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
    {
      p = inquire_write (iqp->file, iqp->file_len);
      cf_strcpy (iqp->write, iqp->write_len, p);
    }

  if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
    {
      p = inquire_read (iqp->file, iqp->file_len);
      cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
    }
}


/* Library entry point for the INQUIRE statement (non-IOLENGTH
   form).  */

extern void st_inquire (st_parameter_inquire *);
export_proto(st_inquire);

void
st_inquire (st_parameter_inquire *iqp)
{
  gfc_unit *u;

  library_start (&iqp->common);

  if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
    {
      u = find_unit (iqp->common.unit);
      inquire_via_unit (iqp, u);
    }
  else
    {
      u = find_file (iqp->file, iqp->file_len);
      if (u == NULL)
	inquire_via_filename (iqp);
      else
	inquire_via_unit (iqp, u);
    }
  if (u != NULL)
    unlock_unit (u);

  library_end ();
}
Commit	Line	Data
5d38f366	1	/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010
5d38f366	2	Free Software Foundation, Inc.
4ee9c684	3	Contributed by Andy Vaught
	4
	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
	6
	7	Libgfortran is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
6bc9506f	9	the Free Software Foundation; either version 3, or (at your option)
4ee9c684	10	any later version.
	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
6bc9506f	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
4ee9c684	25
	26
	27	/* Implement the non-IOLENGTH variant of the INQUIRY statement */
	28
4ee9c684	29	#include "io.h"
f65f6629	30	#include "unix.h"
060da415	31	#include <string.h>
4ee9c684	32
4ee9c684	33
fb35179a	34	static const char undefined[] = "UNDEFINED";
4ee9c684	35
	36
	37	/* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */
	38
	39	static void
60c514ba	40	inquire_via_unit (st_parameter_inquire iqp, gfc_unit u)
4ee9c684	41	{
4ee9c684	42	const char *p;
60c514ba	43	GFC_INTEGER_4 cf = iqp->common.flags;
4ee9c684	44
60c514ba	45	if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
6550bb3d	46	{
	47	*iqp->exist = (iqp->common.unit >= 0
	48	&& iqp->common.unit <= GFC_INTEGER_4_HUGE);
	49
	50	if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
	51	{
	52	if (!(*iqp->exist))
	53	*iqp->common.iostat = LIBERROR_BAD_UNIT;
	54	iqp->exist = iqp->exist
	55	&& (*iqp->common.iostat != LIBERROR_BAD_UNIT);
	56	}
	57	}
4ee9c684	58
60c514ba	59	if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
60c514ba	60	*iqp->opened = (u != NULL);
4ee9c684	61
60c514ba	62	if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
60c514ba	63	*iqp->number = (u != NULL) ? u->unit_number : -1;
4ee9c684	64
60c514ba	65	if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
60c514ba	66	*iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH);
4ee9c684	67
60c514ba	68	if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0
60c514ba	69	&& u != NULL && u->flags.status != STATUS_SCRATCH)
4cdcb18d	70	{
	71	#ifdef HAVE_TTYNAME
	72	if (u->unit_number == options.stdin_unit
	73	\|\| u->unit_number == options.stdout_unit
	74	\|\| u->unit_number == options.stderr_unit)
	75	{
	76	char * tmp = ttyname (((unix_stream *) u->s)->fd);
	77	if (tmp != NULL)
	78	{
	79	int tmplen = strlen (tmp);
	80	fstrcpy (iqp->name, iqp->name_len, tmp, tmplen);
	81	}
	82	else /* If ttyname does not work, go with the default. */
	83	fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
	84	}
	85	else
	86	#endif
	87	fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len);
	88	}
4ee9c684	89
60c514ba	90	if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
4ee9c684	91	{
	92	if (u == NULL)
	93	p = undefined;
	94	else
	95	switch (u->flags.access)
	96	{
	97	case ACCESS_SEQUENTIAL:
	98	p = "SEQUENTIAL";
	99	break;
	100	case ACCESS_DIRECT:
	101	p = "DIRECT";
	102	break;
4d8ee55b	103	case ACCESS_STREAM:
	104	p = "STREAM";
	105	break;
4ee9c684	106	default:
60c514ba	107	internal_error (&iqp->common, "inquire_via_unit(): Bad access");
4ee9c684	108	}
4ee9c684	109
60c514ba	110	cf_strcpy (iqp->access, iqp->access_len, p);
4ee9c684	111	}
4ee9c684	112
60c514ba	113	if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
4ee9c684	114	{
214b69f2	115	if (u == NULL)
	116	p = inquire_sequential (NULL, 0);
	117	else
2e1fa727	118	switch (u->flags.access)
	119	{
	120	case ACCESS_DIRECT:
	121	case ACCESS_STREAM:
	122	p = "NO";
	123	break;
	124	case ACCESS_SEQUENTIAL:
	125	p = "YES";
	126	break;
	127	default:
	128	internal_error (&iqp->common, "inquire_via_unit(): Bad access");
	129	}
4ee9c684	130
60c514ba	131	cf_strcpy (iqp->sequential, iqp->sequential_len, p);
4ee9c684	132	}
4ee9c684	133
60c514ba	134	if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
4ee9c684	135	{
2e1fa727	136	if (u == NULL)
	137	p = inquire_direct (NULL, 0);
	138	else
	139	switch (u->flags.access)
	140	{
	141	case ACCESS_SEQUENTIAL:
	142	case ACCESS_STREAM:
	143	p = "NO";
	144	break;
	145	case ACCESS_DIRECT:
	146	p = "YES";
	147	break;
	148	default:
	149	internal_error (&iqp->common, "inquire_via_unit(): Bad access");
	150	}
4ee9c684	151
60c514ba	152	cf_strcpy (iqp->direct, iqp->direct_len, p);
4ee9c684	153	}
4ee9c684	154
60c514ba	155	if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
4ee9c684	156	{
	157	if (u == NULL)
	158	p = undefined;
	159	else
	160	switch (u->flags.form)
	161	{
	162	case FORM_FORMATTED:
	163	p = "FORMATTED";
	164	break;
	165	case FORM_UNFORMATTED:
	166	p = "UNFORMATTED";
	167	break;
	168	default:
60c514ba	169	internal_error (&iqp->common, "inquire_via_unit(): Bad form");
4ee9c684	170	}
4ee9c684	171
60c514ba	172	cf_strcpy (iqp->form, iqp->form_len, p);
4ee9c684	173	}
4ee9c684	174
60c514ba	175	if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
4ee9c684	176	{
2e1fa727	177	if (u == NULL)
	178	p = inquire_formatted (NULL, 0);
	179	else
	180	switch (u->flags.form)
	181	{
	182	case FORM_FORMATTED:
	183	p = "YES";
	184	break;
	185	case FORM_UNFORMATTED:
	186	p = "NO";
	187	break;
	188	default:
	189	internal_error (&iqp->common, "inquire_via_unit(): Bad form");
	190	}
4ee9c684	191
60c514ba	192	cf_strcpy (iqp->formatted, iqp->formatted_len, p);
4ee9c684	193	}
4ee9c684	194
60c514ba	195	if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
4ee9c684	196	{
2e1fa727	197	if (u == NULL)
	198	p = inquire_unformatted (NULL, 0);
	199	else
	200	switch (u->flags.form)
	201	{
	202	case FORM_FORMATTED:
	203	p = "NO";
	204	break;
	205	case FORM_UNFORMATTED:
	206	p = "YES";
	207	break;
	208	default:
	209	internal_error (&iqp->common, "inquire_via_unit(): Bad form");
	210	}
4ee9c684	211
60c514ba	212	cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
4ee9c684	213	}
4ee9c684	214
60c514ba	215	if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
60c514ba	216	*iqp->recl_out = (u != NULL) ? u->recl : 0;
4ee9c684	217
4d8ee55b	218	if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0)
3c43c91f	219	*iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
4d8ee55b	220
60c514ba	221	if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
f4bfed80	222	{
	223	/* This only makes sense in the context of DIRECT access. */
	224	if (u != NULL && u->flags.access == ACCESS_DIRECT)
	225	*iqp->nextrec = u->last_record + 1;
	226	else
	227	*iqp->nextrec = 0;
	228	}
4ee9c684	229
60c514ba	230	if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
4ee9c684	231	{
8e327405	232	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
4ee9c684	233	p = undefined;
	234	else
	235	switch (u->flags.blank)
	236	{
	237	case BLANK_NULL:
60c514ba	238	p = "NULL";
4ee9c684	239	break;
	240	case BLANK_ZERO:
	241	p = "ZERO";
	242	break;
	243	default:
60c514ba	244	internal_error (&iqp->common, "inquire_via_unit(): Bad blank");
4ee9c684	245	}
4ee9c684	246
60c514ba	247	cf_strcpy (iqp->blank, iqp->blank_len, p);
4ee9c684	248	}
4ee9c684	249
8e327405	250	if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
	251	{
	252	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
	253	p = undefined;
	254	else
	255	switch (u->flags.pad)
	256	{
	257	case PAD_YES:
	258	p = "YES";
	259	break;
	260	case PAD_NO:
	261	p = "NO";
	262	break;
	263	default:
	264	internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
	265	}
	266
	267	cf_strcpy (iqp->pad, iqp->pad_len, p);
	268	}
	269
0d72fa67	270	if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
8e327405	271	{
b5d015e3	272	GFC_INTEGER_4 cf2 = iqp->flags2;
b5d015e3	273
0d72fa67	274	if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
	275	*iqp->pending = 0;
	276
	277	if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
	278	*iqp->id = 0;
8e327405	279
0d72fa67	280	if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
	281	{
	282	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
	283	p = undefined;
	284	else
	285	switch (u->flags.encoding)
	286	{
	287	case ENCODING_DEFAULT:
	288	p = "UNKNOWN";
	289	break;
	290	case ENCODING_UTF8:
	291	p = "UTF-8";
	292	break;
	293	default:
	294	internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
	295	}
	296
	297	cf_strcpy (iqp->encoding, iqp->encoding_len, p);
	298	}
8e327405	299
0d72fa67	300	if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
	301	{
	302	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
	303	p = undefined;
	304	else
	305	switch (u->flags.decimal)
	306	{
	307	case DECIMAL_POINT:
	308	p = "POINT";
	309	break;
	310	case DECIMAL_COMMA:
	311	p = "COMMA";
	312	break;
	313	default:
	314	internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
	315	}
	316
	317	cf_strcpy (iqp->decimal, iqp->decimal_len, p);
	318	}
8e327405	319
0d72fa67	320	if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
	321	{
	322	if (u == NULL)
	323	p = undefined;
	324	else
	325	switch (u->flags.async)
	326	{
	327	case ASYNC_YES:
	328	p = "YES";
	329	break;
	330	case ASYNC_NO:
	331	p = "NO";
	332	break;
	333	default:
	334	internal_error (&iqp->common, "inquire_via_unit(): Bad async");
	335	}
	336
	337	cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
	338	}
8e327405	339
0d72fa67	340	if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
	341	{
	342	if (u == NULL)
	343	p = undefined;
	344	else
	345	switch (u->flags.sign)
	346	{
	347	case SIGN_PROCDEFINED:
	348	p = "PROCESSOR_DEFINED";
	349	break;
	350	case SIGN_SUPPRESS:
	351	p = "SUPPRESS";
	352	break;
	353	case SIGN_PLUS:
	354	p = "PLUS";
	355	break;
	356	default:
	357	internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
	358	}
	359
	360	cf_strcpy (iqp->sign, iqp->sign_len, p);
	361	}
8e327405	362
0d72fa67	363	if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
	364	{
	365	if (u == NULL)
	366	p = undefined;
	367	else
	368	switch (u->flags.round)
	369	{
	370	case ROUND_UP:
	371	p = "UP";
	372	break;
	373	case ROUND_DOWN:
	374	p = "DOWN";
	375	break;
	376	case ROUND_ZERO:
	377	p = "ZERO";
	378	break;
	379	case ROUND_NEAREST:
	380	p = "NEAREST";
	381	break;
	382	case ROUND_COMPATIBLE:
	383	p = "COMPATIBLE";
	384	break;
	385	case ROUND_PROCDEFINED:
	386	p = "PROCESSOR_DEFINED";
	387	break;
	388	default:
	389	internal_error (&iqp->common, "inquire_via_unit(): Bad round");
	390	}
	391
	392	cf_strcpy (iqp->round, iqp->round_len, p);
	393	}
f4e9c676	394
	395	if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
	396	{
	397	if (u == NULL)
	398	*iqp->size = -1;
	399	else
	400	*iqp->size = file_size (u->file, (gfc_charlen_type) u->file_len);
	401	}
8e327405	402	}
8e327405	403
60c514ba	404	if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
4ee9c684	405	{
4ee9c684	406	if (u == NULL \|\| u->flags.access == ACCESS_DIRECT)
b3b0377b	407	p = undefined;
4ee9c684	408	else
b3b0377b	409	switch (u->flags.position)
	410	{
	411	case POSITION_REWIND:
	412	p = "REWIND";
	413	break;
	414	case POSITION_APPEND:
	415	p = "APPEND";
	416	break;
	417	case POSITION_ASIS:
	418	p = "ASIS";
	419	break;
	420	default:
	421	/* if not direct access, it must be
	422	either REWIND, APPEND, or ASIS.
	423	ASIS seems to be the best default */
	424	p = "ASIS";
	425	break;
	426	}
60c514ba	427	cf_strcpy (iqp->position, iqp->position_len, p);
4ee9c684	428	}
4ee9c684	429
60c514ba	430	if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0)
4ee9c684	431	{
	432	if (u == NULL)
	433	p = undefined;
	434	else
	435	switch (u->flags.action)
	436	{
	437	case ACTION_READ:
	438	p = "READ";
	439	break;
	440	case ACTION_WRITE:
	441	p = "WRITE";
	442	break;
	443	case ACTION_READWRITE:
	444	p = "READWRITE";
	445	break;
	446	default:
60c514ba	447	internal_error (&iqp->common, "inquire_via_unit(): Bad action");
4ee9c684	448	}
4ee9c684	449
60c514ba	450	cf_strcpy (iqp->action, iqp->action_len, p);
4ee9c684	451	}
4ee9c684	452
60c514ba	453	if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
4ee9c684	454	{
	455	p = (u == NULL) ? inquire_read (NULL, 0) :
	456	inquire_read (u->file, u->file_len);
	457
60c514ba	458	cf_strcpy (iqp->read, iqp->read_len, p);
4ee9c684	459	}
4ee9c684	460
60c514ba	461	if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
4ee9c684	462	{
	463	p = (u == NULL) ? inquire_write (NULL, 0) :
	464	inquire_write (u->file, u->file_len);
	465
60c514ba	466	cf_strcpy (iqp->write, iqp->write_len, p);
4ee9c684	467	}
4ee9c684	468
60c514ba	469	if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
4ee9c684	470	{
	471	p = (u == NULL) ? inquire_readwrite (NULL, 0) :
	472	inquire_readwrite (u->file, u->file_len);
	473
60c514ba	474	cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
4ee9c684	475	}
4ee9c684	476
60c514ba	477	if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
4ee9c684	478	{
	479	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
	480	p = undefined;
	481	else
	482	switch (u->flags.delim)
	483	{
	484	case DELIM_NONE:
	485	p = "NONE";
	486	break;
	487	case DELIM_QUOTE:
	488	p = "QUOTE";
	489	break;
	490	case DELIM_APOSTROPHE:
	491	p = "APOSTROPHE";
	492	break;
	493	default:
60c514ba	494	internal_error (&iqp->common, "inquire_via_unit(): Bad delim");
4ee9c684	495	}
4ee9c684	496
60c514ba	497	cf_strcpy (iqp->delim, iqp->delim_len, p);
4ee9c684	498	}
4ee9c684	499
60c514ba	500	if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
4ee9c684	501	{
	502	if (u == NULL \|\| u->flags.form != FORM_FORMATTED)
	503	p = undefined;
	504	else
	505	switch (u->flags.pad)
	506	{
	507	case PAD_NO:
	508	p = "NO";
	509	break;
	510	case PAD_YES:
	511	p = "YES";
	512	break;
	513	default:
60c514ba	514	internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
4ee9c684	515	}
4ee9c684	516
60c514ba	517	cf_strcpy (iqp->pad, iqp->pad_len, p);
4ee9c684	518	}
9e94d29f	519
	520	if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0)
	521	{
	522	if (u == NULL)
	523	p = undefined;
	524	else
	525	switch (u->flags.convert)
	526	{
1316e8f0	527	/* big_endian is 0 for little-endian, 1 for big-endian. */
18f0b7df	528	case GFC_CONVERT_NATIVE:
1316e8f0	529	p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
9e94d29f	530	break;
9e94d29f	531
18f0b7df	532	case GFC_CONVERT_SWAP:
1316e8f0	533	p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
9e94d29f	534	break;
	535
	536	default:
	537	internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
	538	}
	539
	540	cf_strcpy (iqp->convert, iqp->convert_len, p);
	541	}
4ee9c684	542	}
	543
	544
	545	/* inquire_via_filename()-- Inquiry via filename. This subroutine is
	546	* only used if the filename is not connected to a unit number. */
	547
	548	static void
60c514ba	549	inquire_via_filename (st_parameter_inquire *iqp)
4ee9c684	550	{
4ee9c684	551	const char *p;
60c514ba	552	GFC_INTEGER_4 cf = iqp->common.flags;
4ee9c684	553
60c514ba	554	if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
60c514ba	555	*iqp->exist = file_exists (iqp->file, iqp->file_len);
4ee9c684	556
60c514ba	557	if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
60c514ba	558	*iqp->opened = 0;
4ee9c684	559
60c514ba	560	if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0)
60c514ba	561	*iqp->number = -1;
4ee9c684	562
60c514ba	563	if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0)
60c514ba	564	*iqp->named = 1;
4ee9c684	565
60c514ba	566	if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0)
60c514ba	567	fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len);
4ee9c684	568
60c514ba	569	if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
60c514ba	570	cf_strcpy (iqp->access, iqp->access_len, undefined);
4ee9c684	571
60c514ba	572	if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
4ee9c684	573	{
2e1fa727	574	p = "UNKNOWN";
60c514ba	575	cf_strcpy (iqp->sequential, iqp->sequential_len, p);
4ee9c684	576	}
4ee9c684	577
60c514ba	578	if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
4ee9c684	579	{
2e1fa727	580	p = "UNKNOWN";
60c514ba	581	cf_strcpy (iqp->direct, iqp->direct_len, p);
4ee9c684	582	}
4ee9c684	583
60c514ba	584	if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0)
60c514ba	585	cf_strcpy (iqp->form, iqp->form_len, undefined);
4ee9c684	586
60c514ba	587	if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
4ee9c684	588	{
2e1fa727	589	p = "UNKNOWN";
60c514ba	590	cf_strcpy (iqp->formatted, iqp->formatted_len, p);
4ee9c684	591	}
4ee9c684	592
60c514ba	593	if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
4ee9c684	594	{
2e1fa727	595	p = "UNKNOWN";
60c514ba	596	cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
4ee9c684	597	}
4ee9c684	598
60c514ba	599	if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0)
60c514ba	600	*iqp->recl_out = 0;
4ee9c684	601
60c514ba	602	if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
60c514ba	603	*iqp->nextrec = 0;
4ee9c684	604
60c514ba	605	if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
60c514ba	606	cf_strcpy (iqp->blank, iqp->blank_len, undefined);
4ee9c684	607
8e327405	608	if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
	609	cf_strcpy (iqp->pad, iqp->pad_len, undefined);
	610
0d72fa67	611	if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
0d72fa67	612	{
b5d015e3	613	GFC_INTEGER_4 cf2 = iqp->flags2;
b5d015e3	614
0d72fa67	615	if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
0d72fa67	616	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
8e327405	617
0d72fa67	618	if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
	619	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
	620
	621	if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
	622	cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
8e327405	623
0d72fa67	624	if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
	625	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
	626
	627	if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
	628	cf_strcpy (iqp->pad, iqp->pad_len, undefined);
	629
	630	if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
	631	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
f4e9c676	632
	633	if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0)
	634	*iqp->size = file_size (iqp->file, iqp->file_len);
0d72fa67	635	}
8e327405	636
60c514ba	637	if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
60c514ba	638	cf_strcpy (iqp->position, iqp->position_len, undefined);
4ee9c684	639
60c514ba	640	if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0)
60c514ba	641	cf_strcpy (iqp->access, iqp->access_len, undefined);
4ee9c684	642
60c514ba	643	if ((cf & IOPARM_INQUIRE_HAS_READ) != 0)
4ee9c684	644	{
60c514ba	645	p = inquire_read (iqp->file, iqp->file_len);
60c514ba	646	cf_strcpy (iqp->read, iqp->read_len, p);
4ee9c684	647	}
4ee9c684	648
60c514ba	649	if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0)
4ee9c684	650	{
60c514ba	651	p = inquire_write (iqp->file, iqp->file_len);
60c514ba	652	cf_strcpy (iqp->write, iqp->write_len, p);
4ee9c684	653	}
4ee9c684	654
60c514ba	655	if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0)
4ee9c684	656	{
60c514ba	657	p = inquire_read (iqp->file, iqp->file_len);
60c514ba	658	cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
4ee9c684	659	}
4ee9c684	660	}
	661
	662
6799e2f8	663	/* Library entry point for the INQUIRE statement (non-IOLENGTH
6799e2f8	664	form). */
4ee9c684	665
60c514ba	666	extern void st_inquire (st_parameter_inquire *);
7b6cb5bd	667	export_proto(st_inquire);
7b6cb5bd	668
4ee9c684	669	void
60c514ba	670	st_inquire (st_parameter_inquire *iqp)
4ee9c684	671	{
f02dd226	672	gfc_unit *u;
4ee9c684	673
60c514ba	674	library_start (&iqp->common);
4ee9c684	675
60c514ba	676	if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0)
	677	{
	678	u = find_unit (iqp->common.unit);
	679	inquire_via_unit (iqp, u);
	680	}
4ee9c684	681	else
4ee9c684	682	{
60c514ba	683	u = find_file (iqp->file, iqp->file_len);
4ee9c684	684	if (u == NULL)
60c514ba	685	inquire_via_filename (iqp);
4ee9c684	686	else
60c514ba	687	inquire_via_unit (iqp, u);
4ee9c684	688	}
60c514ba	689	if (u != NULL)
60c514ba	690	unlock_unit (u);
4ee9c684	691
	692	library_end ();
	693	}