-/* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007, 2009 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 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
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.
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+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 "config.h"
-#include "libgfortran.h"
#include "io.h"
GFC_INTEGER_4 cf = iqp->common.flags;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
- *iqp->exist = iqp->common.unit >= 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 (u == NULL)
p = inquire_sequential (NULL, 0);
else
- {
- /* disallow an open direct access file to be accessed sequentially */
- if (u->flags.access == ACCESS_DIRECT)
- p = "NO";
- else
- p = inquire_sequential (u->file, u->file_len);
- }
+ 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)
{
- p = (u == NULL) ? inquire_direct (NULL, 0) :
- inquire_direct (u->file, u->file_len);
+ 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_FORMATTED) != 0)
{
- p = (u == NULL) ? inquire_formatted (NULL, 0) :
- inquire_formatted (u->file, u->file_len);
+ 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)
{
- p = (u == NULL) ? inquire_unformatted (NULL, 0) :
- inquire_unformatted (u->file, u->file_len);
+ 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_BLANK) != 0)
{
- if (u == NULL)
+ if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.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 ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
{
if (u == NULL || u->flags.access == ACCESS_DIRECT)
else
switch (u->flags.convert)
{
- /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */
- case CONVERT_NATIVE:
- p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
+ /* big_endian is 0 for little-endian, 1 for big-endian. */
+ case GFC_CONVERT_NATIVE:
+ p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
break;
- case CONVERT_SWAP:
- p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
+ case GFC_CONVERT_SWAP:
+ p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
break;
default:
if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0)
{
- p = inquire_sequential (iqp->file, iqp->file_len);
+ p = "UNKNOWN";
cf_strcpy (iqp->sequential, iqp->sequential_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0)
{
- p = inquire_direct (iqp->file, iqp->file_len);
+ p = "UNKNOWN";
cf_strcpy (iqp->direct, iqp->direct_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0)
{
- p = inquire_formatted (iqp->file, iqp->file_len);
+ p = "UNKNOWN";
cf_strcpy (iqp->formatted, iqp->formatted_len, p);
}
if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0)
{
- p = inquire_unformatted (iqp->file, iqp->file_len);
+ p = "UNKNOWN";
cf_strcpy (iqp->unformatted, iqp->unformatted_len, p);
}
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 ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
cf_strcpy (iqp->position, iqp->position_len, undefined);
p = inquire_read (iqp->file, iqp->file_len);
cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
}
-
- if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
- cf_strcpy (iqp->delim, iqp->delim_len, undefined);
-
- if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
- cf_strcpy (iqp->pad, iqp->pad_len, undefined);
}
projects / thirdparty / gcc.git / blobdiff