OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/61933 (Inquire on internal units)

Browse Source 
2015-01-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/61933
	* io/inquire.c (inquire_via_unit): Set existing to true if a
	gfc_unit stucture was found for the given unit number.
	* runtime/error.c (translate_error): Add case for
	LIBERROR_INQUIRE_INTERNAL_UNIT.

From-SVN: r219631
This commit is contained in:
Jerry DeLisle 2015-01-15 03:57:29 +00:00
parent 2da229cb17
commit 351b443252
3 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2015-01-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/61933
* io/inquire.c (inquire_via_unit): Set existing to true if a
gfc_unit stucture was found for the given unit number.
* runtime/error.c (translate_error): Add case for
LIBERROR_INQUIRE_INTERNAL_UNIT.
2015-01-05 Jakub Jelinek <jakub@redhat.com>
Update copyright years.

16
libgfortran/io/inquire.c
View File

@ -41,19 +41,11 @@ 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 (iqp->common.unit == -1)
generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
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_EXIST) != 0)
*iqp->exist = (u != NULL);
if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
*iqp->opened = (u != NULL);

4
libgfortran/runtime/error.c
View File

@ -488,6 +488,10 @@ translate_error (int code)
p = "Unformatted file structure has been corrupted";
break;
case LIBERROR_INQUIRE_INTERNAL_UNIT:
p = "Inquire statement identifies an internal file";
break;
default:
p = "Unknown error code";
break;