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
|
||||
--- 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.
|
||||
@@ -502,6 +502,10 @@ fdec-math
|
||||
Fortran Var(flag_dec_math)
|
||||
Enable legacy math intrinsics for compatibility.
|
||||
|
||||
+fdec-override-kind
|
||||
+Fortran Var(flag_dec_override_kind)
|
||||
+Enable support for per variable kind specification.
|
||||
+
|
||||
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 d6bd36c3a8a..edbab483b36 100644
|
||||
--- a/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_non_integer_index, value, value);
|
||||
SET_BITFLAG (flag_dec_old_init, 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