aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog14
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/io.c6
-rw-r--r--gcc/fortran/ioparm.def2
-rw-r--r--gcc/fortran/libgfortran.h7
-rw-r--r--gcc/fortran/resolve.c1
-rw-r--r--gcc/fortran/trans-io.c6
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/dtio_14.f9064
-rw-r--r--gcc/testsuite/gfortran.dg/negative_unit_check.f901
10 files changed, 102 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7a99c39..daed721 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2016-09-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/48298
+ * gfortran.h (gfc_dt): Add *udtio.
+ * ioparm.def: Add bit IOPARM_dt_f2003 to align with library use of bit
+ 25. Add IOPARM_dt_dtio bit to common flags.
+ * resolve.c (resolve_transfer): Set dt->udtio to expression.
+ * io.c (gfc_match_inquire): Adjust error message for internal
+ unit KIND.
+ * libgfortran.h: Adjust defines for GFC_INTERNAL_UNIT4,
+ GFC_INTERNAL_UNIT, and GFC_INVALID_UNIT.
+ * trans-io.c (build_dt): Set common_unit to reflect the KIND of
+ the internal unit. Set mask bit for presence of dt->udtio.
+
2016-09-22 Andre Vehreschild <vehre@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Use the old caf-
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 912f5fb..1837a53 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2332,7 +2332,7 @@ typedef struct
{
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
- *sign, *extra_comma, *dt_io_kind;
+ *sign, *extra_comma, *dt_io_kind, *udtio;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 53037e2..48c15ef 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -4256,9 +4256,11 @@ gfc_match_inquire (void)
if (inquire->unit != NULL && inquire->unit->expr_type == EXPR_CONSTANT
&& inquire->unit->ts.type == BT_INTEGER
- && mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT)
+ && ((mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT4)
+ || (mpz_get_si (inquire->unit->value.integer) == GFC_INTERNAL_UNIT)))
{
- gfc_error ("UNIT number in INQUIRE statement at %L can not be -1", &loc);
+ gfc_error ("UNIT number in INQUIRE statement at %L can not "
+ "be %d", &loc, (int) mpz_get_si (inquire->unit->value.integer));
goto cleanup;
}
diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def
index e448a92..17b7ac7 100644
--- a/gcc/fortran/ioparm.def
+++ b/gcc/fortran/ioparm.def
@@ -113,3 +113,5 @@ IOPARM (dt, delim, 1 << 21, char2)
IOPARM (dt, pad, 1 << 22, char1)
IOPARM (dt, round, 1 << 23, char2)
IOPARM (dt, sign, 1 << 24, char1)
+#define IOPARM_dt_f2003 (1 << 25)
+#define IOPARM_dt_dtio (1 << 26)
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index e913250..cc35508 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -68,10 +68,11 @@ along with GCC; see the file COPYING3. If not see
| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \
| GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM)
-/* Special unit numbers used to convey certain conditions. Numbers -3
+/* Special unit numbers used to convey certain conditions. Numbers -4
thru -9 available. NEWUNIT values start at -10. */
-#define GFC_INTERNAL_UNIT -1
-#define GFC_INVALID_UNIT -2
+#define GFC_INTERNAL_UNIT4 -1 /* KIND=4 Internal Unit. */
+#define GFC_INTERNAL_UNIT -2 /* KIND=1 Internal Unit. */
+#define GFC_INVALID_UNIT -3
/* Possible values for the CONVERT I/O specifier. */
/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 11b6a14..9998302 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8739,6 +8739,7 @@ resolve_transfer (gfc_code *code)
if (dtio_sub != NULL && exp->expr_type == EXPR_VARIABLE)
{
+ dt->udtio = exp;
sym = exp->symtree->n.sym->ns->proc_name;
/* Check to see if this is a nested DTIO call, with the
dummy as the io-list object. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 2c84349..c0559f3 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1808,7 +1808,8 @@ build_dt (tree function, gfc_code * code)
mask |= set_internal_unit (&block, &post_iu_block,
var, dt->io_unit);
set_parameter_const (&block, var, IOPARM_common_unit,
- dt->io_unit->ts.kind == 1 ? 0 : -1);
+ dt->io_unit->ts.kind == 1 ?
+ GFC_INTERNAL_UNIT : GFC_INTERNAL_UNIT4);
}
}
else
@@ -1892,6 +1893,9 @@ build_dt (tree function, gfc_code * code)
mask |= set_parameter_ref (&block, &post_end_block, var,
IOPARM_dt_size, dt->size);
+ if (dt->udtio)
+ mask |= IOPARM_dt_dtio;
+
if (dt->namelist)
{
if (dt->format_expr || dt->format_label)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6ac5436..09b6599 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-09-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/48298
+ * gfortran.dg/negative_unit_check.f90: Update test.
+ * gfortran.dg/dtio_14.f90: New test.
+
2016-09-23 Dominik Vogt <vogt@linux.vnet.ibm.com>
* gcc.target/s390/hotpatch-compile-1.c: Fixed dg-error test.
diff --git a/gcc/testsuite/gfortran.dg/dtio_14.f90 b/gcc/testsuite/gfortran.dg/dtio_14.f90
new file mode 100644
index 0000000..16d5b1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_14.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+!
+! Functional test of User Defined Derived Type IO with typebound bindings
+! This version tests IO to internal character units.
+!
+MODULE p
+ TYPE :: person
+ CHARACTER (LEN=20) :: name
+ INTEGER(4) :: age
+ CONTAINS
+ procedure :: pwf
+ procedure :: prf
+ GENERIC :: WRITE(FORMATTED) => pwf
+ GENERIC :: READ(FORMATTED) => prf
+ END TYPE person
+CONTAINS
+ SUBROUTINE pwf (dtv,unit,iotype,vlist,iostat,iomsg)
+ CLASS(person), INTENT(IN) :: dtv
+ INTEGER, INTENT(IN) :: unit
+ CHARACTER (LEN=*), INTENT(IN) :: iotype
+ INTEGER, INTENT(IN) :: vlist(:)
+ INTEGER, INTENT(OUT) :: iostat
+ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ WRITE(unit, FMT = *, IOSTAT=iostat) dtv%name, dtv%age
+ END SUBROUTINE pwf
+
+ SUBROUTINE prf (dtv,unit,iotype,vlist,iostat,iomsg)
+ CLASS(person), INTENT(INOUT) :: dtv
+ INTEGER, INTENT(IN) :: unit
+ CHARACTER (LEN=*), INTENT(IN) :: iotype
+ INTEGER, INTENT(IN) :: vlist(:)
+ INTEGER, INTENT(OUT) :: iostat
+ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+ READ (UNIT = UNIT, FMT = *) dtv%name, dtv%age
+ END SUBROUTINE prf
+END MODULE p
+
+PROGRAM test
+ USE p
+ TYPE (person) :: chairman, answer
+ character(kind=1,len=80) :: str1
+ character(kind=4,len=80) :: str4
+ str1 = ""
+ str4 = 4_""
+ chairman%name="Charlie"
+ chairman%age=62
+ answer = chairman
+! KIND=1 test
+ write (str1, *) chairman
+ if (trim(str1).ne." Charlie 62") call abort
+ chairman%name="Bogus"
+ chairman%age=99
+ read (str1, *) chairman
+ if (chairman%name.ne.answer%name) call abort
+ if (chairman%age.ne.answer%age) call abort
+! KIND=4 test
+ write (str4, *) chairman
+ if (trim(str4).ne.4_" Charlie 62") call abort
+ chairman%name="Bogus"
+ chairman%age=99
+ read (str4, *) chairman
+ if (chairman%name.ne.answer%name) call abort
+ if (chairman%age.ne.answer%age) call abort
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/negative_unit_check.f90 b/gcc/testsuite/gfortran.dg/negative_unit_check.f90
index 2a1b16c..002b5b4 100644
--- a/gcc/testsuite/gfortran.dg/negative_unit_check.f90
+++ b/gcc/testsuite/gfortran.dg/negative_unit_check.f90
@@ -2,4 +2,5 @@
! Test case from PR61933.
LOGICAL :: file_exists
INQUIRE(UNIT=-1,EXIST=file_exists)! { dg-error "can not be -1" }
+ INQUIRE(UNIT=-2,EXIST=file_exists)! { dg-error "can not be -2" }
END
generated by cgit v1.1 at 2025-05-22 17:35:59 +0000