Fix up RHEL/ELN Fortran patches.
This commit is contained in:
parent
c75889d28c
commit
91b3540549
@ -1,181 +0,0 @@
|
|||||||
From 7001d522d0273658d9e1fb12ca104d56bfcae34d Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 15:06:08 +0000
|
|
||||||
Subject: [PATCH 10/10] Fill in missing array dimensions using the lower bound
|
|
||||||
|
|
||||||
Use -fdec-add-missing-indexes to enable feature. Also enabled by fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/lang.opt | 8 ++++++++
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
gcc/fortran/resolve.cc | 24 ++++++++++++++++++++++++
|
|
||||||
gcc/testsuite/gfortran.dg/array_6.f90 | 23 +++++++++++++++++++++++
|
|
||||||
gcc/testsuite/gfortran.dg/array_7.f90 | 23 +++++++++++++++++++++++
|
|
||||||
gcc/testsuite/gfortran.dg/array_8.f90 | 23 +++++++++++++++++++++++
|
|
||||||
6 files changed, 102 insertions(+)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/array_6.f90
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/array_7.f90
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/array_8.f90
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index 019c798cf09..f27de88ea3f 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -281,6 +281,10 @@ Wmissing-include-dirs
|
|
||||||
Fortran
|
|
||||||
; Documented in C/C++
|
|
||||||
|
|
||||||
+Wmissing-index
|
|
||||||
+Fortran Var(warn_missing_index) Warning LangEnabledBy(Fortran,Wall)
|
|
||||||
+Warn that the lower bound of a missing index will be used.
|
|
||||||
+
|
|
||||||
Wuse-without-only
|
|
||||||
Fortran Var(warn_use_without_only) Warning
|
|
||||||
Warn about USE statements that have no ONLY qualifier.
|
|
||||||
@@ -460,6 +464,10 @@ fdec
|
|
||||||
Fortran Var(flag_dec)
|
|
||||||
Enable all DEC language extensions.
|
|
||||||
|
|
||||||
+fdec-add-missing-indexes
|
|
||||||
+Fortran Var(flag_dec_add_missing_indexes)
|
|
||||||
+Enable the addition of missing indexes using their lower bounds.
|
|
||||||
+
|
|
||||||
fdec-blank-format-item
|
|
||||||
Fortran Var(flag_dec_blank_format_item)
|
|
||||||
Enable the use of blank format items in format strings.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index 050f56fdc25..c3b2822685d 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -84,6 +84,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_non_logical_if, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_promotion, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_sequence, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_add_missing_indexes, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
||||||
index fe7d0cc5944..0efeedab46e 100644
|
|
||||||
--- a/gcc/fortran/resolve.cc
|
|
||||||
+++ b/gcc/fortran/resolve.cc
|
|
||||||
@@ -4806,6 +4806,30 @@ compare_spec_to_ref (gfc_array_ref *ar)
|
|
||||||
if (ar->type == AR_FULL)
|
|
||||||
return true;
|
|
||||||
|
|
||||||
+ if (flag_dec_add_missing_indexes && as->rank > ar->dimen)
|
|
||||||
+ {
|
|
||||||
+ /* Add in the missing dimensions, assuming they are the lower bound
|
|
||||||
+ of that dimension if not specified. */
|
|
||||||
+ int j;
|
|
||||||
+ if (warn_missing_index)
|
|
||||||
+ {
|
|
||||||
+ gfc_warning (OPT_Wmissing_index, "Using the lower bound for "
|
|
||||||
+ "unspecified dimensions in array reference at %L",
|
|
||||||
+ &ar->where);
|
|
||||||
+ }
|
|
||||||
+ /* Other parts of the code iterate ar->start and ar->end from 0 to
|
|
||||||
+ ar->dimen, so it is safe to assume slots from ar->dimen upwards
|
|
||||||
+ are unused (i.e. there are no gaps; the specified indexes are
|
|
||||||
+ contiguous and start at zero. */
|
|
||||||
+ for(j = ar->dimen; j <= as->rank; j++)
|
|
||||||
+ {
|
|
||||||
+ ar->start[j] = gfc_copy_expr (as->lower[j]);
|
|
||||||
+ ar->end[j] = gfc_copy_expr (as->lower[j]);
|
|
||||||
+ ar->dimen_type[j] = DIMEN_ELEMENT;
|
|
||||||
+ }
|
|
||||||
+ ar->dimen = as->rank;
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (as->rank != ar->dimen)
|
|
||||||
{
|
|
||||||
gfc_error ("Rank mismatch in array reference at %L (%d/%d)",
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..5c26e18ab3e
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/array_6.f90
|
|
||||||
@@ -0,0 +1,23 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec -Wmissing-index" }!
|
|
||||||
+! Checks that under-specified arrays (referencing arrays with fewer
|
|
||||||
+! dimensions than the array spec) generates a warning.
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
|
|
||||||
+!
|
|
||||||
+
|
|
||||||
+program under_specified_array
|
|
||||||
+ integer chessboard(8,8)
|
|
||||||
+ integer chessboard3d(8,8,3:5)
|
|
||||||
+ chessboard(3,1) = 5
|
|
||||||
+ chessboard(3,2) = 55
|
|
||||||
+ chessboard3d(4,1,3) = 6
|
|
||||||
+ chessboard3d(4,1,4) = 66
|
|
||||||
+ chessboard3d(4,4,3) = 7
|
|
||||||
+ chessboard3d(4,4,4) = 77
|
|
||||||
+
|
|
||||||
+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+end program
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/array_7.f90 b/gcc/testsuite/gfortran.dg/array_7.f90
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..5588a5bd02d
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/array_7.f90
|
|
||||||
@@ -0,0 +1,23 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-add-missing-indexes -Wmissing-index" }!
|
|
||||||
+! Checks that under-specified arrays (referencing arrays with fewer
|
|
||||||
+! dimensions than the array spec) generates a warning.
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
|
|
||||||
+!
|
|
||||||
+
|
|
||||||
+program under_specified_array
|
|
||||||
+ integer chessboard(8,8)
|
|
||||||
+ integer chessboard3d(8,8,3:5)
|
|
||||||
+ chessboard(3,1) = 5
|
|
||||||
+ chessboard(3,2) = 55
|
|
||||||
+ chessboard3d(4,1,3) = 6
|
|
||||||
+ chessboard3d(4,1,4) = 66
|
|
||||||
+ chessboard3d(4,4,3) = 7
|
|
||||||
+ chessboard3d(4,4,4) = 77
|
|
||||||
+
|
|
||||||
+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
|
|
||||||
+end program
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/array_8.f90 b/gcc/testsuite/gfortran.dg/array_8.f90
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..f0d2ef5e37d
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/array_8.f90
|
|
||||||
@@ -0,0 +1,23 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-add-missing-indexes" }!
|
|
||||||
+! Checks that under-specified arrays (referencing arrays with fewer
|
|
||||||
+! dimensions than the array spec) generates a warning.
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
|
|
||||||
+!
|
|
||||||
+
|
|
||||||
+program under_specified_array
|
|
||||||
+ integer chessboard(8,8)
|
|
||||||
+ integer chessboard3d(8,8,3:5)
|
|
||||||
+ chessboard(3,1) = 5
|
|
||||||
+ chessboard(3,2) = 55
|
|
||||||
+ chessboard3d(4,1,3) = 6
|
|
||||||
+ chessboard3d(4,1,4) = 66
|
|
||||||
+ chessboard3d(4,4,3) = 7
|
|
||||||
+ chessboard3d(4,4,4) = 77
|
|
||||||
+
|
|
||||||
+ if (chessboard(3).ne.5) stop 1 ! { dg-error "Rank mismatch" }
|
|
||||||
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-error "Rank mismatch" }
|
|
||||||
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-error "Rank mismatch" }
|
|
||||||
+end program
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -1,78 +0,0 @@
|
|||||||
From f883ac209b0feea860354cb4ef7ff06dc8063fab Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 12:53:35 +0000
|
|
||||||
Subject: [PATCH 03/10] Allow more than one character as argument to ICHAR
|
|
||||||
|
|
||||||
Use -fdec to enable.
|
|
||||||
---
|
|
||||||
gcc/fortran/check.cc | 2 +-
|
|
||||||
gcc/fortran/simplify.cc | 4 ++--
|
|
||||||
.../gfortran.dg/dec_ichar_with_string_1.f | 21 +++++++++++++++++++
|
|
||||||
3 files changed, 24 insertions(+), 3 deletions(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
|
|
||||||
index 82db8e4e1b2..623c1cc470e 100644
|
|
||||||
--- a/gcc/fortran/check.cc
|
|
||||||
+++ b/gcc/fortran/check.cc
|
|
||||||
@@ -3157,7 +3157,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
|
|
||||||
else
|
|
||||||
return true;
|
|
||||||
|
|
||||||
- if (i != 1)
|
|
||||||
+ if (i != 1 && !flag_dec)
|
|
||||||
{
|
|
||||||
gfc_error ("Argument of %s at %L must be of length one",
|
|
||||||
gfc_current_intrinsic, &c->where);
|
|
||||||
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
|
|
||||||
index 23317a2e2d9..9900572424f 100644
|
|
||||||
--- a/gcc/fortran/simplify.cc
|
|
||||||
+++ b/gcc/fortran/simplify.cc
|
|
||||||
@@ -3261,7 +3261,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
|
|
||||||
if (e->expr_type != EXPR_CONSTANT)
|
|
||||||
return NULL;
|
|
||||||
|
|
||||||
- if (e->value.character.length != 1)
|
|
||||||
+ if (e->value.character.length != 1 && !flag_dec)
|
|
||||||
{
|
|
||||||
gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
|
|
||||||
return &gfc_bad_expr;
|
|
||||||
@@ -3459,7 +3459,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
|
|
||||||
if (e->expr_type != EXPR_CONSTANT)
|
|
||||||
return NULL;
|
|
||||||
|
|
||||||
- if (e->value.character.length != 1)
|
|
||||||
+ if (e->value.character.length != 1 && !flag_dec)
|
|
||||||
{
|
|
||||||
gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
|
|
||||||
return &gfc_bad_expr;
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..85efccecc0f
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
|
|
||||||
@@ -0,0 +1,21 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test ICHAR and IACHAR with more than one character as argument
|
|
||||||
+!
|
|
||||||
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM ichar_more_than_one_character
|
|
||||||
+ CHARACTER*4 st/'Test'/
|
|
||||||
+ INTEGER i
|
|
||||||
+
|
|
||||||
+ i = ICHAR(st)
|
|
||||||
+ if (i.NE.84) STOP 1
|
|
||||||
+ i = IACHAR(st)
|
|
||||||
+ if (i.NE.84) STOP 2
|
|
||||||
+ i = ICHAR('Test')
|
|
||||||
+ if (i.NE.84) STOP 3
|
|
||||||
+ i = IACHAR('Test')
|
|
||||||
+ if (i.NE.84) STOP 4
|
|
||||||
+ END
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -1,158 +0,0 @@
|
|||||||
From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 13:09:54 +0000
|
|
||||||
Subject: [PATCH 04/10] Allow non-integer substring indexes
|
|
||||||
|
|
||||||
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/lang.opt | 4 ++++
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
gcc/fortran/resolve.cc | 20 +++++++++++++++++++
|
|
||||||
.../dec_not_integer_substring_indexes_1.f | 18 +++++++++++++++++
|
|
||||||
.../dec_not_integer_substring_indexes_2.f | 18 +++++++++++++++++
|
|
||||||
.../dec_not_integer_substring_indexes_3.f | 18 +++++++++++++++++
|
|
||||||
6 files changed, 79 insertions(+)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index c4da248f07c..d527c106bd6 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -489,6 +489,10 @@ fdec-math
|
|
||||||
Fortran Var(flag_dec_math)
|
|
||||||
Enable legacy math intrinsics for compatibility.
|
|
||||||
|
|
||||||
+fdec-non-integer-index
|
|
||||||
+Fortran Var(flag_dec_non_integer_index)
|
|
||||||
+Enable support for non-integer substring indexes.
|
|
||||||
+
|
|
||||||
fdec-structure
|
|
||||||
Fortran Var(flag_dec_structure)
|
|
||||||
Enable support for DEC STRUCTURE/RECORD.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index f19ba87f8a0..9a042f64881 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -78,6 +78,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_blank_format_item, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_char_conversions, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_duplicates, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_non_integer_index, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
||||||
index 4b90cb59902..bc0df0fdb99 100644
|
|
||||||
--- a/gcc/fortran/resolve.cc
|
|
||||||
+++ b/gcc/fortran/resolve.cc
|
|
||||||
@@ -5131,6 +5131,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
|
|
||||||
if (!gfc_resolve_expr (ref->u.ss.start))
|
|
||||||
return false;
|
|
||||||
|
|
||||||
+ /* In legacy mode, allow non-integer string indexes by converting */
|
|
||||||
+ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
|
|
||||||
+ && gfc_numeric_ts (&ref->u.ss.start->ts))
|
|
||||||
+ {
|
|
||||||
+ gfc_typespec t;
|
|
||||||
+ t.type = BT_INTEGER;
|
|
||||||
+ t.kind = ref->u.ss.start->ts.kind;
|
|
||||||
+ gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (ref->u.ss.start->ts.type != BT_INTEGER)
|
|
||||||
{
|
|
||||||
gfc_error ("Substring start index at %L must be of type INTEGER",
|
|
||||||
@@ -5160,6 +5170,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
|
|
||||||
if (!gfc_resolve_expr (ref->u.ss.end))
|
|
||||||
return false;
|
|
||||||
|
|
||||||
+ /* Non-integer string index endings, as for start */
|
|
||||||
+ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
|
|
||||||
+ && gfc_numeric_ts (&ref->u.ss.end->ts))
|
|
||||||
+ {
|
|
||||||
+ gfc_typespec t;
|
|
||||||
+ t.type = BT_INTEGER;
|
|
||||||
+ t.kind = ref->u.ss.end->ts.kind;
|
|
||||||
+ gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (ref->u.ss.end->ts.type != BT_INTEGER)
|
|
||||||
{
|
|
||||||
gfc_error ("Substring end index at %L must be of type INTEGER",
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..0be28abaa4b
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
|
||||||
@@ -0,0 +1,18 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test not integer substring indexes
|
|
||||||
+!
|
|
||||||
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM not_integer_substring_indexes
|
|
||||||
+ CHARACTER*5 st/'Tests'/
|
|
||||||
+ REAL ir/1.0/
|
|
||||||
+ REAL ir2/4.0/
|
|
||||||
+
|
|
||||||
+ if (st(ir:4).ne.'Test') stop 1
|
|
||||||
+ if (st(1:ir2).ne.'Test') stop 2
|
|
||||||
+ if (st(1.0:4).ne.'Test') stop 3
|
|
||||||
+ if (st(1:4.0).ne.'Test') stop 4
|
|
||||||
+ if (st(2.5:4).ne.'est') stop 5
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..3cf05296d0c
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
|
||||||
@@ -0,0 +1,18 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-non-integer-index" }
|
|
||||||
+!
|
|
||||||
+! Test not integer substring indexes
|
|
||||||
+!
|
|
||||||
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM not_integer_substring_indexes
|
|
||||||
+ CHARACTER*5 st/'Tests'/
|
|
||||||
+ REAL ir/1.0/
|
|
||||||
+ REAL ir2/4.0/
|
|
||||||
+
|
|
||||||
+ if (st(ir:4).ne.'Test') stop 1
|
|
||||||
+ if (st(1:ir2).ne.'Test') stop 2
|
|
||||||
+ if (st(1.0:4).ne.'Test') stop 3
|
|
||||||
+ if (st(1:4.0).ne.'Test') stop 4
|
|
||||||
+ if (st(2.5:4).ne.'est') stop 5
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..703de995897
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
|
||||||
@@ -0,0 +1,18 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-non-integer-index" }
|
|
||||||
+!
|
|
||||||
+! Test not integer substring indexes
|
|
||||||
+!
|
|
||||||
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM not_integer_substring_indexes
|
|
||||||
+ CHARACTER*5 st/'Tests'/
|
|
||||||
+ REAL ir/1.0/
|
|
||||||
+ REAL ir2/4.0/
|
|
||||||
+
|
|
||||||
+ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
|
|
||||||
+ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
|
|
||||||
+ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
|
|
||||||
+ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
|
|
||||||
+ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
|
|
||||||
+ END
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -1,185 +0,0 @@
|
|||||||
From 8bcc0f85ed1718c0dd9033ad4a34df181aabaffe Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 13:11:06 +0000
|
|
||||||
Subject: [PATCH 05/10] Allow old-style initializers in derived types
|
|
||||||
|
|
||||||
This allows simple declarations in derived types and structures, such as:
|
|
||||||
LOGICAL*1 NIL /0/
|
|
||||||
Only single value expressions are allowed at the moment.
|
|
||||||
|
|
||||||
Use -fdec-old-init to enable. Also enabled by -fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/decl.cc | 27 +++++++++++++++----
|
|
||||||
gcc/fortran/lang.opt | 4 +++
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
...ec_derived_types_initialised_old_style_1.f | 25 +++++++++++++++++
|
|
||||||
...ec_derived_types_initialised_old_style_2.f | 25 +++++++++++++++++
|
|
||||||
...ec_derived_types_initialised_old_style_3.f | 26 ++++++++++++++++++
|
|
||||||
6 files changed, 103 insertions(+), 5 deletions(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
|
|
||||||
index 723915822f3..5c8c1b7981b 100644
|
|
||||||
--- a/gcc/fortran/decl.cc
|
|
||||||
+++ b/gcc/fortran/decl.cc
|
|
||||||
@@ -2827,12 +2827,29 @@ variable_decl (int elem)
|
|
||||||
but not components of derived types. */
|
|
||||||
else if (gfc_current_state () == COMP_DERIVED)
|
|
||||||
{
|
|
||||||
- gfc_error ("Invalid old style initialization for derived type "
|
|
||||||
- "component at %C");
|
|
||||||
- m = MATCH_ERROR;
|
|
||||||
- goto cleanup;
|
|
||||||
+ if (flag_dec_old_init)
|
|
||||||
+ {
|
|
||||||
+ /* Attempt to match an old-style initializer which is a simple
|
|
||||||
+ integer or character expression; this will not work with
|
|
||||||
+ multiple values. */
|
|
||||||
+ m = gfc_match_init_expr (&initializer);
|
|
||||||
+ if (m == MATCH_ERROR)
|
|
||||||
+ goto cleanup;
|
|
||||||
+ else if (m == MATCH_YES)
|
|
||||||
+ {
|
|
||||||
+ m = gfc_match ("/");
|
|
||||||
+ if (m != MATCH_YES)
|
|
||||||
+ goto cleanup;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ else
|
|
||||||
+ {
|
|
||||||
+ gfc_error ("Invalid old style initialization for derived type "
|
|
||||||
+ "component at %C");
|
|
||||||
+ m = MATCH_ERROR;
|
|
||||||
+ goto cleanup;
|
|
||||||
+ }
|
|
||||||
}
|
|
||||||
-
|
|
||||||
/* For structure components, read the initializer as a special
|
|
||||||
expression and let the rest of this function apply the initializer
|
|
||||||
as usual. */
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index d527c106bd6..25cc948699b 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -493,6 +493,10 @@ fdec-non-integer-index
|
|
||||||
Fortran Var(flag_dec_non_integer_index)
|
|
||||||
Enable support for non-integer substring indexes.
|
|
||||||
|
|
||||||
+fdec-old-init
|
|
||||||
+Fortran Var(flag_dec_old_init)
|
|
||||||
+Enable support for old style initializers in derived types.
|
|
||||||
+
|
|
||||||
fdec-structure
|
|
||||||
Fortran Var(flag_dec_structure)
|
|
||||||
Enable support for DEC STRUCTURE/RECORD.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index 9a042f64881..d6bd36c3a8a 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -79,6 +79,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_char_conversions, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_duplicates, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_non_integer_index, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_old_init, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..eac4f9bfcf1
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
|
|
||||||
@@ -0,0 +1,25 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test old style initializers in derived types
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM spec_in_var
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID /8/
|
|
||||||
+ INTEGER*4 TYPE /5/
|
|
||||||
+ INTEGER*8 DEFVAL /0/
|
|
||||||
+ CHARACTER*(5) NAME /'tests'/
|
|
||||||
+ LOGICAL*1 NIL /0/
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+
|
|
||||||
+ TYPE (STRUCT1) SINST
|
|
||||||
+
|
|
||||||
+ IF(SINST%ID.NE.8) STOP 1
|
|
||||||
+ IF(SINST%TYPE.NE.5) STOP 2
|
|
||||||
+ IF(SINST%DEFVAL.NE.0) STOP 3
|
|
||||||
+ IF(SINST%NAME.NE.'tests') STOP 4
|
|
||||||
+ IF(SINST%NIL) STOP 5
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..d904c8b2974
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
|
|
||||||
@@ -0,0 +1,25 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-std=legacy -fdec-old-init" }
|
|
||||||
+!
|
|
||||||
+! Test old style initializers in derived types
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM spec_in_var
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID /8/
|
|
||||||
+ INTEGER*4 TYPE /5/
|
|
||||||
+ INTEGER*8 DEFVAL /0/
|
|
||||||
+ CHARACTER*(5) NAME /'tests'/
|
|
||||||
+ LOGICAL*1 NIL /0/
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+
|
|
||||||
+ TYPE (STRUCT1) SINST
|
|
||||||
+
|
|
||||||
+ IF(SINST%ID.NE.8) STOP 1
|
|
||||||
+ IF(SINST%TYPE.NE.5) STOP 2
|
|
||||||
+ IF(SINST%DEFVAL.NE.0) STOP 3
|
|
||||||
+ IF(SINST%NAME.NE.'tests') STOP 4
|
|
||||||
+ IF(SINST%NIL) STOP 5
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..58c2b4b66cf
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
|
|
||||||
@@ -0,0 +1,26 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-std=legacy -fdec -fno-dec-old-init" }
|
|
||||||
+!
|
|
||||||
+! Test old style initializers in derived types
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+
|
|
||||||
+ PROGRAM spec_in_var
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID /8/ ! { dg-error "Invalid old style initialization" }
|
|
||||||
+ INTEGER*4 TYPE /5/ ! { dg-error "Invalid old style initialization" }
|
|
||||||
+ INTEGER*8 DEFVAL /0/ ! { dg-error "Invalid old style initialization" }
|
|
||||||
+ CHARACTER*(5) NAME /'tests'/ ! { dg-error "Invalid old style initialization" }
|
|
||||||
+ LOGICAL*1 NIL /0/ ! { dg-error "Invalid old style initialization" }
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+
|
|
||||||
+ TYPE (STRUCT1) SINST
|
|
||||||
+
|
|
||||||
+ IF(SINST%ID.NE.8) STOP 1 ! { dg-error "'id' at \\(1\\) is not a member" }
|
|
||||||
+ IF(SINST%TYPE.NE.5) STOP 2 ! { dg-error "'type' at \\(1\\) is not a member" }
|
|
||||||
+ IF(SINST%DEFVAL.NE.0) STOP 3 ! { dg-error "'defval' at \\(1\\) is not a member" }
|
|
||||||
+ IF(SINST%NAME.NE.'tests') STOP 4 ! { dg-error "'name' at \\(1\\) is not a member" }
|
|
||||||
+ IF(SINST%NIL) STOP 5 ! { dg-error "'nil' at \\(1\\) is not a member" }
|
|
||||||
+ END
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -281,25 +281,25 @@ diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|||||||
index 25cc948699b..4a269ebb22d 100644
|
index 25cc948699b..4a269ebb22d 100644
|
||||||
--- a/gcc/fortran/lang.opt
|
--- a/gcc/fortran/lang.opt
|
||||||
+++ b/gcc/fortran/lang.opt
|
+++ b/gcc/fortran/lang.opt
|
||||||
@@ -493,6 +493,10 @@ fdec-non-integer-index
|
@@ -502,6 +502,10 @@ fdec-math
|
||||||
Fortran Var(flag_dec_non_integer_index)
|
Fortran Var(flag_dec_math)
|
||||||
Enable support for non-integer substring indexes.
|
Enable legacy math intrinsics for compatibility.
|
||||||
|
|
||||||
+fdec-override-kind
|
+fdec-override-kind
|
||||||
+Fortran Var(flag_dec_override_kind)
|
+Fortran Var(flag_dec_override_kind)
|
||||||
+Enable support for per variable kind specification.
|
+Enable support for per variable kind specification.
|
||||||
+
|
+
|
||||||
fdec-old-init
|
fdec-structure
|
||||||
Fortran Var(flag_dec_old_init)
|
Fortran Var(flag_dec_structure)
|
||||||
Enable support for old style initializers in derived types.
|
Enable support for DEC STRUCTURE/RECORD.
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
||||||
index d6bd36c3a8a..edbab483b36 100644
|
index d6bd36c3a8a..edbab483b36 100644
|
||||||
--- a/gcc/fortran/options.cc
|
--- a/gcc/fortran/options.cc
|
||||||
+++ b/gcc/fortran/options.cc
|
+++ b/gcc/fortran/options.cc
|
||||||
@@ -80,6 +80,7 @@ set_dec_flags (int value)
|
@@ -78,6 +78,7 @@ set_dec_flags (int value)
|
||||||
|
SET_BITFLAG (flag_dec_blank_format_item, value, value);
|
||||||
|
SET_BITFLAG (flag_dec_char_conversions, value, value);
|
||||||
SET_BITFLAG (flag_dec_duplicates, value, value);
|
SET_BITFLAG (flag_dec_duplicates, value, value);
|
||||||
SET_BITFLAG (flag_dec_non_integer_index, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_old_init, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_override_kind, value, value);
|
+ SET_BITFLAG (flag_dec_override_kind, value, value);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -1,262 +0,0 @@
|
|||||||
From bb76446db10c21860a4e19569ce3e350d8a2b59f Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 15:00:44 +0000
|
|
||||||
Subject: [PATCH 09/10] Add the SEQUENCE attribute by default if it's not
|
|
||||||
present.
|
|
||||||
|
|
||||||
Use -fdec-sequence to enable this feature. Also enabled by -fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/lang.opt | 4 ++
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
gcc/fortran/resolve.cc | 13 ++++-
|
|
||||||
...dd_SEQUENCE_to_COMMON_block_by_default_1.f | 57 +++++++++++++++++++
|
|
||||||
...dd_SEQUENCE_to_COMMON_block_by_default_2.f | 57 +++++++++++++++++++
|
|
||||||
...dd_SEQUENCE_to_COMMON_block_by_default_3.f | 57 +++++++++++++++++++
|
|
||||||
6 files changed, 186 insertions(+), 3 deletions(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index 4ca2f93f2df..019c798cf09 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -509,6 +509,10 @@ fdec-promotion
|
|
||||||
Fortran Var(flag_dec_promotion)
|
|
||||||
Add support for type promotion in intrinsic arguments.
|
|
||||||
|
|
||||||
+fdec-sequence
|
|
||||||
+Fortran Var(flag_dec_sequence)
|
|
||||||
+Add the SEQUENCE attribute by default if it's not present.
|
|
||||||
+
|
|
||||||
fdec-structure
|
|
||||||
Fortran Var(flag_dec_structure)
|
|
||||||
Enable support for DEC STRUCTURE/RECORD.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index 15079c7e95a..050f56fdc25 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -83,6 +83,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_override_kind, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_non_logical_if, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_promotion, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_sequence, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
||||||
index 07dd039f3bf..fe7d0cc5944 100644
|
|
||||||
--- a/gcc/fortran/resolve.cc
|
|
||||||
+++ b/gcc/fortran/resolve.cc
|
|
||||||
@@ -978,9 +978,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
|
|
||||||
|
|
||||||
if (!(csym->ts.u.derived->attr.sequence
|
|
||||||
|| csym->ts.u.derived->attr.is_bind_c))
|
|
||||||
- gfc_error_now ("Derived type variable %qs in COMMON at %L "
|
|
||||||
- "has neither the SEQUENCE nor the BIND(C) "
|
|
||||||
- "attribute", csym->name, &csym->declared_at);
|
|
||||||
+ {
|
|
||||||
+ if (flag_dec_sequence)
|
|
||||||
+ /* Assume sequence. */
|
|
||||||
+ csym->ts.u.derived->attr.sequence = 1;
|
|
||||||
+ else
|
|
||||||
+ gfc_error_now ("Derived type variable '%s' in COMMON at %L "
|
|
||||||
+ "has neither the SEQUENCE nor the BIND(C) "
|
|
||||||
+ "attribute", csym->name, &csym->declared_at);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (csym->ts.u.derived->attr.alloc_comp)
|
|
||||||
gfc_error_now ("Derived type variable %qs in COMMON at %L "
|
|
||||||
"has an ultimate component that is "
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..fe7b39625eb
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
|
|
||||||
@@ -0,0 +1,57 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test add default SEQUENCE attribute derived types appearing in
|
|
||||||
+! COMMON blocks and EQUIVALENCE statements.
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ MODULE SEQ
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID
|
|
||||||
+ INTEGER*4 TYPE
|
|
||||||
+ INTEGER*8 DEFVAL
|
|
||||||
+ CHARACTER*(4) NAME
|
|
||||||
+ LOGICAL*1 NIL
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+ END MODULE
|
|
||||||
+
|
|
||||||
+ SUBROUTINE A
|
|
||||||
+ USE SEQ
|
|
||||||
+ TYPE (STRUCT1) S
|
|
||||||
+ COMMON /BLOCK1/ S
|
|
||||||
+ IF (S%ID.NE.5) STOP 1
|
|
||||||
+ IF (S%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+ END SUBROUTINE
|
|
||||||
+
|
|
||||||
+ PROGRAM sequence_att_common
|
|
||||||
+ USE SEQ
|
|
||||||
+ IMPLICIT NONE
|
|
||||||
+ TYPE (STRUCT1) S1
|
|
||||||
+ TYPE (STRUCT1) S2
|
|
||||||
+ TYPE (STRUCT1) S3
|
|
||||||
+
|
|
||||||
+ EQUIVALENCE (S1,S2)
|
|
||||||
+ COMMON /BLOCK1/ S3
|
|
||||||
+
|
|
||||||
+ S1%ID = 5
|
|
||||||
+ S1%TYPE = 1000
|
|
||||||
+ S1%DEFVAL = -99
|
|
||||||
+ S1%NAME = "JANE"
|
|
||||||
+ S1%NIL = .FALSE.
|
|
||||||
+
|
|
||||||
+ IF (S2%ID.NE.5) STOP 1
|
|
||||||
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+
|
|
||||||
+ S3 = S1
|
|
||||||
+
|
|
||||||
+ CALL A
|
|
||||||
+
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..83512f0f3a2
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
|
|
||||||
@@ -0,0 +1,57 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-sequence" }
|
|
||||||
+!
|
|
||||||
+! Test add default SEQUENCE attribute derived types appearing in
|
|
||||||
+! COMMON blocks and EQUIVALENCE statements.
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ MODULE SEQ
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID
|
|
||||||
+ INTEGER*4 TYPE
|
|
||||||
+ INTEGER*8 DEFVAL
|
|
||||||
+ CHARACTER*(4) NAME
|
|
||||||
+ LOGICAL*1 NIL
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+ END MODULE
|
|
||||||
+
|
|
||||||
+ SUBROUTINE A
|
|
||||||
+ USE SEQ
|
|
||||||
+ TYPE (STRUCT1) S
|
|
||||||
+ COMMON /BLOCK1/ S
|
|
||||||
+ IF (S%ID.NE.5) STOP 1
|
|
||||||
+ IF (S%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+ END SUBROUTINE
|
|
||||||
+
|
|
||||||
+ PROGRAM sequence_att_common
|
|
||||||
+ USE SEQ
|
|
||||||
+ IMPLICIT NONE
|
|
||||||
+ TYPE (STRUCT1) S1
|
|
||||||
+ TYPE (STRUCT1) S2
|
|
||||||
+ TYPE (STRUCT1) S3
|
|
||||||
+
|
|
||||||
+ EQUIVALENCE (S1,S2)
|
|
||||||
+ COMMON /BLOCK1/ S3
|
|
||||||
+
|
|
||||||
+ S1%ID = 5
|
|
||||||
+ S1%TYPE = 1000
|
|
||||||
+ S1%DEFVAL = -99
|
|
||||||
+ S1%NAME = "JANE"
|
|
||||||
+ S1%NIL = .FALSE.
|
|
||||||
+
|
|
||||||
+ IF (S2%ID.NE.5) STOP 1
|
|
||||||
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+
|
|
||||||
+ S3 = S1
|
|
||||||
+
|
|
||||||
+ CALL A
|
|
||||||
+
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..26cd59f9090
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
|
|
||||||
@@ -0,0 +1,57 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-sequence" }
|
|
||||||
+!
|
|
||||||
+! Test add default SEQUENCE attribute derived types appearing in
|
|
||||||
+! COMMON blocks and EQUIVALENCE statements.
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ MODULE SEQ
|
|
||||||
+ TYPE STRUCT1
|
|
||||||
+ INTEGER*4 ID
|
|
||||||
+ INTEGER*4 TYPE
|
|
||||||
+ INTEGER*8 DEFVAL
|
|
||||||
+ CHARACTER*(4) NAME
|
|
||||||
+ LOGICAL*1 NIL
|
|
||||||
+ END TYPE STRUCT1
|
|
||||||
+ END MODULE
|
|
||||||
+
|
|
||||||
+ SUBROUTINE A
|
|
||||||
+ USE SEQ
|
|
||||||
+ TYPE (STRUCT1) S ! { dg-error "Derived type variable" }
|
|
||||||
+ COMMON /BLOCK1/ S
|
|
||||||
+ IF (S%ID.NE.5) STOP 1
|
|
||||||
+ IF (S%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+ END SUBROUTINE
|
|
||||||
+
|
|
||||||
+ PROGRAM sequence_att_common
|
|
||||||
+ USE SEQ
|
|
||||||
+ IMPLICIT NONE
|
|
||||||
+ TYPE (STRUCT1) S1
|
|
||||||
+ TYPE (STRUCT1) S2
|
|
||||||
+ TYPE (STRUCT1) S3 ! { dg-error "Derived type variable" }
|
|
||||||
+
|
|
||||||
+ EQUIVALENCE (S1,S2) ! { dg-error "Derived type variable" }
|
|
||||||
+ COMMON /BLOCK1/ S3
|
|
||||||
+
|
|
||||||
+ S1%ID = 5
|
|
||||||
+ S1%TYPE = 1000
|
|
||||||
+ S1%DEFVAL = -99
|
|
||||||
+ S1%NAME = "JANE"
|
|
||||||
+ S1%NIL = .FALSE.
|
|
||||||
+
|
|
||||||
+ IF (S2%ID.NE.5) STOP 1
|
|
||||||
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
||||||
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
||||||
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
||||||
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
||||||
+
|
|
||||||
+ S3 = S1
|
|
||||||
+
|
|
||||||
+ CALL A
|
|
||||||
+
|
|
||||||
+ END
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user