https://gcc.gnu.org/ml/fortran/2016-10/msg00087.html et. al.
> On 12/10/16 13:30, Fritz Reese wrote:
>> Here I submit for review four small extensions to the GNU Fortran
>> frontend for compatibility with legacy code. I figure it might be a
>> nice change of pace from my larger patches. Never fear, for I have
>> more large patches to come, which I will continue to submit
>> one-at-a-time.
Sorry I took a break from this last week. Back on it this week. I
really hope I can get the rest of my major extensions in before the
next release stage, which is apparently imminent, so I might have an
overwhelming number of submissions this week...
Here's how I'm thinking of the flags situation: we use -std=legacy for
old compatibility stuff that users shouldn't use, and -fdec for
ancient compatibility stuff that users _really_ shouldn't use. So if a
user wants the compiler to mimic an old DEC compiler they hit -fdec
and get -std=legacy and all the bells and whistles of the
deleted/obsolete/compatibility extensions without question. Otherwise
they can just use -std=legacy for a more reasonable compilation, or
-std=gnu for some such extensions with reasonable warnings.
Anyway, here's a resubmission of the several patches for the four
extensions mentioned previously, plus an initial cleanup patch for
-fdec. Sorry to pork-barrel the cleanup patch in here, but it combines
some stuff I've been meaning to touch up with the change of making
-fdec into flag_dec using Fortran Var. (This is necessary for the
type-print and future extensions to be enabled with -fdec without
their own flag.)
To summarize, we have
0001 Cleanup -fdec: rolls some options in with fdec that were
documented as being a part of it previously (-fdollar-ok,
-fcray-pointer, -fd-lines-as-comments, legacy/deleted/obsolete feature
standard bits) and moves fdec-structure out of gfc_option to use
Fortran Var.
0002 [always] Form feed: feed characters ('\f') accepted as whitespace in source
0003 [-fdec] TYPE is an alias for PRINT
0004 [-std=legacy] %LOC() can be used as an rval (like the LOC() intrinsic)
0005 [-std=legacy] Support for .XOR. operator (same as .NEQV.)
The -std=legacy extensions of course compile clean with -std=legacy,
give warnings with-std=gnu, and give errors with -std=f*.
OK for trunk now? (regtests x86_64-redhat-linux)
---
Fritz Reese
==> 0001-Cleanup-fdec.patch <==
>From e2563d592af111c7f67ea7f3e41cf6b83d294b1e Mon Sep 17 00:00:00 2001
From: Fritz Reese <[email protected]>
Date: Mon, 24 Oct 2016 09:56:11 -0400
Subject: [PATCH 1/5] Cleanup -fdec.
gcc/fortran/
* invoke.texi, gfortran.texi: Touch up documentation of -fdec.
* gfortran.h (gfc_option): Move flag_dec_structure out of gfc_option.
* decl.c (match_record_decl, gfc_match_decl_type_spec,
gfc_match_structure_decl): Ditto.
* match.c (gfc_match_member_sep): Ditto.
* options.c (gfc_handle_option): Ditto.
* lang.opt (fdec-structure): Use Fortran Var for flag_dec_structure.
* lang.opt (fdec): Use Fortran Var to create flag_dec.
* options.c (set_dec_flags): With -fdec enable -fcray-pointer,
-fd-lines-as-comments (default), and legacy/deleted/obsolete standards.
==> 0002-Treat-form-feed-as-whitespace.patch <==
>From d771dd0e49c30498b6dbd94e1edc3689b5a5cab3 Mon Sep 17 00:00:00 2001
From: Fritz Reese <[email protected]>
Date: Mon, 17 Oct 2016 08:44:27 -0400
Subject: [PATCH 2/5] Treat form feed as whitespace.
gcc/fortran/
* gfortran.texi: Document.
* gfortran.h (gfc_is_whitespace): Include form feed ('\f').
gcc/testsuite/gfortran.dg/
* feed_1.f90, feed_2.f90: New testcases.
==> 0003-Support-TYPE-as-alias-for-PRINT-with-fdec.patch <==
>From 3a26fbde4ace44b3565872f84c2f2dfcec813cb8 Mon Sep 17 00:00:00 2001
From: Fritz Reese <[email protected]>
Date: Mon, 24 Oct 2016 09:56:53 -0400
Subject: [PATCH 3/5] Support TYPE as alias for PRINT with -fdec.
gcc/fortran/
* decl.c (gfc_match_type): New function.
* match.h (gfc_match_type): New function.
* match.c (gfc_match_if): Special case for one-line IFs.
* gfortran.texi: Update documentation.
* parse.c (decode_statement): Invoke gfc_match_type.
gcc/testsuite/gfortran.dg/
* dec_type_print.f90: New testcase.
==> 0004-Enable-LOC-as-an-rvalue-with-std-legacy.patch <==
>From 965d3a0f3dfd4597ce5c1108bb75141e95dd1fbc Mon Sep 17 00:00:00 2001
From: Fritz Reese <[email protected]>
Date: Mon, 24 Oct 2016 09:46:58 -0400
Subject: [PATCH 4/5] Enable %LOC as an rvalue with -std=legacy.
gcc/fortran/
* primary.c (gfc_match_rvalue): Match %LOC as LOC with -std=legacy.
* gfortran.texi: Document.
gcc/testsuite/gfortran.dg/
* dec_loc_rval_1.f90, dec_loc_rval_2.f90, dec_loc_rval_3.f90: New.
==> 0005-Enable-.XOR.-operator-with-std-legacy.patch <==
>From 72f1ffbd6d7d277b212aa5265b439c87a644cb55 Mon Sep 17 00:00:00 2001
From: Fritz Reese <[email protected]>
Date: Mon, 24 Oct 2016 09:50:22 -0400
Subject: [PATCH 5/5] Enable .XOR. operator with -std=legacy.
gcc/fortran/
* gfortran.texi: Document.
* match.c (gfc_match_intrinsic_op): Match ".XOR." with -std=legacy.
gcc/testsuite/gfortran.dg/
* dec_logical_xor_1.f90, dec_logical_xor_2.f90, dec_logical_xor_3.f90:
New testsuites.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index bc27f66..e47d8ed 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2929,7 +2929,7 @@ match_record_decl (char *name)
m = gfc_match (" record /");
if (m == MATCH_YES)
{
- if (!gfc_option.flag_dec_structure)
+ if (!flag_dec_structure)
{
gfc_current_locus = old_loc;
gfc_error ("RECORD at %C is an extension, enable it with "
@@ -2942,7 +2942,7 @@ match_record_decl (char *name)
}
gfc_current_locus = old_loc;
- if (gfc_option.flag_dec_structure
+ if (flag_dec_structure
&& (gfc_match (" record% ") == MATCH_YES
|| gfc_match (" record%t") == MATCH_YES))
gfc_error ("Structure name expected after RECORD at %C");
@@ -3145,7 +3145,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
{
/* Match nested STRUCTURE declarations; only valid within another
structure declaration. */
- if (gfc_option.flag_dec_structure
+ if (flag_dec_structure
&& (gfc_current_state () == COMP_STRUCTURE
|| gfc_current_state () == COMP_MAP))
{
@@ -8654,7 +8654,7 @@ gfc_match_structure_decl (void)
match m;
locus where;
- if(!gfc_option.flag_dec_structure)
+ if(!flag_dec_structure)
{
gfc_error ("STRUCTURE at %C is a DEC extension, enable with "
"-fdec-structure");
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 33de0ff..78a75e5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2549,8 +2549,6 @@ typedef struct
int flag_init_character;
char flag_init_character_value;
- int flag_dec_structure;
-
int fpe;
int fpe_summary;
int rtcheck;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 301c286..fa1f17c 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1437,7 +1437,8 @@ purely for backward compatibility with legacy compilers. By default,
extensions, but to warn about the use of the latter. Specifying
either @option{-std=f95}, @option{-std=f2003} or @option{-std=f2008}
disables both types of extensions, and @option{-std=legacy} allows both
-without warning.
+without warning. The special compile flag @option{-fdec} enables additional
+compatibility extensions along with those enabled by @option{-std=legacy}.
@menu
* Old-style kind specifications::
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 655ee6f..ebf3aba 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -236,12 +236,15 @@ comment lines.
DEC compatibility mode. Enables extensions and other features that mimic
the default behavior of older compilers (such as DEC).
These features are non-standard and should be avoided at all costs.
-For details on GNU Fortran's implementation of these extensions see the
+For details on GNU Fortran's implementation of these extensions see the
full documentation.
Other flags enabled by this switch are:
@option{-fdollar-ok} @option{-fcray-pointer} @option{-fdec-structure}
-@option{-fdec-intrinsic-ints} @option{-fdec-static}
+@option{-fdec-intrinsic-ints} @option{-fdec-static} @option{-fdec-math}
+
+If @option{-fd-lines-as-code}/@option{-fd-lines-as-comments} are unset, then
+@option{-fdec} also sets @option{-fd-lines-as-comments}.
@item -fdec-structure
@opindex @code{fdec-structure}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index b563e09..2e76403 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -421,7 +421,7 @@ Fortran RejectNegative
Treat lines with 'D' in column one as comments.
fdec
-Fortran
+Fortran Var(flag_dec)
Enable all DEC language extensions.
fdec-intrinsic-ints
@@ -433,7 +433,7 @@ Fortran Var(flag_dec_math)
Enable legacy math intrinsics for compatibility.
fdec-structure
-Fortran
+Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
fdec-static
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 9056cb7..d747320 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -159,7 +159,7 @@ gfc_match_member_sep(gfc_symbol *sym)
return MATCH_YES;
/* Beware ye who enter here. */
- if (!gfc_option.flag_dec_structure || !sym)
+ if (!flag_dec_structure || !sym)
return MATCH_NO;
tsym = NULL;
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 93403f7..2b90654 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -47,15 +47,27 @@ set_default_std_flags (void)
}
-/* Set all the DEC extension flags. */
+/* Set all the DEC extension flags. */
static void
set_dec_flags (int value)
{
- gfc_option.flag_dec_structure = value;
- flag_dec_intrinsic_ints = value;
- flag_dec_static = value;
- flag_dec_math = value;
+ /* Allow legacy code without warnings. */
+ gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL
+ | GFC_STD_GNU | GFC_STD_LEGACY;
+ gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL);
+
+ /* Set -fd-lines-as-comments by default. */
+ if (value && gfc_current_form != FORM_FREE && gfc_option.flag_d_lines == -1)
+ gfc_option.flag_d_lines = 0;
+
+ /* Set other DEC compatibility extensions. */
+ flag_dollar_ok |= value;
+ flag_cray_pointer |= value;
+ flag_dec_structure |= value;
+ flag_dec_intrinsic_ints |= value;
+ flag_dec_static |= value;
+ flag_dec_math |= value;
}
@@ -729,7 +741,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
break;
case OPT_fdec_structure:
- gfc_option.flag_dec_structure = 1;
+ flag_dec_structure = 1;
break;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 78a75e5..37423b7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -60,7 +60,7 @@ not after.
#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
-#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
+#define gfc_is_whitespace(c) ((c==' ') || (c=='\t') || (c=='\f'))
/* Macros to check for groups of structure-like types and flavors since
derived types, structures, maps, unions are often treated similarly. */
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index fa1f17c..688b956 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1465,6 +1465,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
* Type variants for integer intrinsics::
* AUTOMATIC and STATIC attributes::
* Extended math intrinsics::
+* Form feed as whitespace::
@end menu
@node Old-style kind specifications
@@ -2510,6 +2511,16 @@ and then multiplying it by a constant radian-to-degree (or degree-to-radian)
factor, as appropriate. The factor is computed at compile-time as 180/pi (or
pi/180).
+@node Form feed as whitespace
+@subsection Form feed as whitespace
+@cindex form feed whitespace
+
+Historically, legacy compilers allowed insertion of form feed characters ('\f',
+ASCII 0xC) at the beginning of lines for formatted output to line printers,
+though the Fortran standard does not mention this. GNU Fortran supports the
+interpretation of form feed characters in source as whitespace for
+compatibility.
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
diff --git a/gcc/testsuite/gfortran.dg/feed_1.f90 b/gcc/testsuite/gfortran.dg/feed_1.f90
new file mode 100644
index 0000000..4dc98a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/feed_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+! Test acceptance of form feed character in free source.
+
+implicit none
+integer, volatile :: x
+
+
+
+x = 5
+
+end
diff --git a/gcc/testsuite/gfortran.dg/feed_2.f90 b/gcc/testsuite/gfortran.dg/feed_2.f90
new file mode 100644
index 0000000..c55435f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/feed_2.f90
@@ -0,0 +1,12 @@
+ ! { dg-do compile }
+ ! { dg-options "-ffixed-form" }
+ ! Test acceptance of form feed character in fixed source.
+
+ implicit none
+ integer, volatile :: x
+
+
+
+ x = 5
+
+ end
--
1.7.1
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index e47d8ed..6c9d057 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8710,6 +8710,100 @@ gfc_match_structure_decl (void)
return MATCH_YES;
}
+
+/* This function does some work to determine which matcher should be used to
+ * match a statement beginning with "TYPE". This is used to disambiguate TYPE
+ * as an alias for PRINT from derived type declarations, TYPE IS statements,
+ * and derived type data declarations. */
+
+match
+gfc_match_type (gfc_statement *st)
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ match m;
+ locus old_loc;
+
+ /* Requires -fdec. */
+ if (!flag_dec)
+ return MATCH_NO;
+
+ m = gfc_match ("type");
+ if (m != MATCH_YES)
+ return m;
+ /* If we already have an error in the buffer, it is probably from failing to
+ * match a derived type data declaration. Let it happen. */
+ else if (gfc_error_flag_test ())
+ return MATCH_NO;
+
+ old_loc = gfc_current_locus;
+ *st = ST_NONE;
+
+ /* If we see an attribute list before anything else it's definitely a derived
+ * type declaration. */
+ if (gfc_match (" ,") == MATCH_YES || gfc_match (" ::") == MATCH_YES)
+ {
+ gfc_current_locus = old_loc;
+ *st = ST_DERIVED_DECL;
+ return gfc_match_derived_decl ();
+ }
+
+ /* By now "TYPE" has already been matched. If we do not see a name, this may
+ * be something like "TYPE *" or "TYPE <fmt>". */
+ m = gfc_match_name (name);
+ if (m != MATCH_YES)
+ {
+ /* Let print match if it can, otherwise throw an error from
+ * gfc_match_derived_decl. */
+ gfc_current_locus = old_loc;
+ if (gfc_match_print () == MATCH_YES)
+ {
+ *st = ST_WRITE;
+ return MATCH_YES;
+ }
+ gfc_current_locus = old_loc;
+ *st = ST_DERIVED_DECL;
+ return gfc_match_derived_decl ();
+ }
+
+ /* A derived type declaration requires an EOS. Without it, assume print. */
+ m = gfc_match_eos ();
+ if (m == MATCH_NO)
+ {
+ /* Check manually for TYPE IS (... - this is invalid print syntax. */
+ if (strncmp ("is", name, 3) == 0
+ && gfc_match (" (", name) == MATCH_YES)
+ {
+ gfc_current_locus = old_loc;
+ gcc_assert (gfc_match (" is") == MATCH_YES);
+ *st = ST_TYPE_IS;
+ return gfc_match_type_is ();
+ }
+ gfc_current_locus = old_loc;
+ *st = ST_WRITE;
+ return gfc_match_print ();
+ }
+ else
+ {
+ /* By now we have "TYPE <name> <EOS>". Check first if the name is an
+ * intrinsic typename - if so let gfc_match_derived_decl dump an error.
+ * Otherwise if gfc_match_derived_decl fails it's probably an existing
+ * symbol which can be printed. */
+ gfc_current_locus = old_loc;
+ m = gfc_match_derived_decl ();
+ if (gfc_is_intrinsic_typename (name) || m == MATCH_YES)
+ {
+ *st = ST_DERIVED_DECL;
+ return m;
+ }
+ gfc_current_locus = old_loc;
+ *st = ST_WRITE;
+ return gfc_match_print ();
+ }
+
+ return MATCH_NO;
+}
+
+
/* Match the beginning of a derived type declaration. If a type name
was the result of a function, then it is possible to have a symbol
already to be known as a derived type yet have no components. */
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 688b956..fb47c13 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1466,6 +1466,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
* AUTOMATIC and STATIC attributes::
* Extended math intrinsics::
* Form feed as whitespace::
+* TYPE as an alias for PRINT::
@end menu
@node Old-style kind specifications
@@ -2521,6 +2522,21 @@ though the Fortran standard does not mention this. GNU Fortran supports the
interpretation of form feed characters in source as whitespace for
compatibility.
+@node TYPE as an alias for PRINT
+@subsection TYPE as an alias for PRINT
+@cindex type alias print
+For compatibility, GNU Fortran will interpret @code{TYPE} statements as
+@code{PRINT} statements with the flag @option{-fdec}. With this flag asserted,
+the following two examples are equivalent:
+
+@smallexample
+TYPE *, 'hello world'
+@end smallexample
+
+@smallexample
+PRINT *, 'hello world'
+@end smallexample
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d747320..046028e 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1622,6 +1622,9 @@ gfc_match_if (gfc_statement *if_type)
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
+ if (flag_dec)
+ match ("type", gfc_match_print, ST_WRITE)
+
/* The gfc_match_assignment() above may have returned a MATCH_NO
where the assignment was to a named constant. Check that
special case here. */
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 2413163..eeb2693 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -214,6 +214,7 @@ match gfc_match_union (void);
match gfc_match_structure_decl (void);
match gfc_match_derived_decl (void);
match gfc_match_final_decl (void);
+match gfc_match_type (gfc_statement *);
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 73cb0db..c617b65 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -413,6 +413,12 @@ decode_statement (void)
gfc_undo_symbols ();
gfc_current_locus = old_locus;
+ /* Try to match TYPE as an alias for PRINT. */
+ if (gfc_match_type (&st) == MATCH_YES)
+ return st;
+ gfc_undo_symbols ();
+ gfc_current_locus = old_locus;
+
match (NULL, gfc_match_do, ST_DO);
match (NULL, gfc_match_block, ST_BLOCK);
match (NULL, gfc_match_associate, ST_ASSOCIATE);
diff --git a/gcc/testsuite/gfortran.dg/dec_type_print.f90 b/gcc/testsuite/gfortran.dg/dec_type_print.f90
new file mode 100644
index 0000000..ca40798
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_type_print.f90
@@ -0,0 +1,84 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Test the usage of TYPE as an alias for PRINT.
+!
+! Note the heavy use of other TYPE statements to test for
+! regressions involving ambiguity.
+!
+program main
+
+logical bool
+integer i /0/, j /1/, k /2/
+character(*), parameter :: fmtstr = "(A11)"
+namelist /nmlist/ i, j, k
+integer, parameter :: n = 5
+real a(n)
+
+! derived type declarations
+type is
+ integer i
+end type
+
+type point
+ real x, y
+end type point
+
+type, extends(point) :: point_3d
+ real :: z
+end type point_3d
+
+type, extends(point) :: color_point
+ integer :: color
+end type color_point
+
+! declaration type specification
+type(is) x
+type(point), target :: p
+type(point_3d), target :: p3
+type(color_point), target :: c
+class(point), pointer :: p_or_c
+
+! select type
+p_or_c => c
+select type ( a => p_or_c )
+ class is ( point )
+ print *, "point" ! <===
+ type is ( point_3d )
+ print *, "point 3D"
+end select
+
+! Type as alias for print
+type*
+type *
+type*,'St','ar'
+type *, 'St', 'ar'
+type 10, 'Integer literal'
+type 10, 'Integer variable'
+type '(A11)', 'Character literal'
+type fmtstr, 'Character variable'
+type nmlist ! namelist
+
+a(1) = 0
+call f(.true., a, n)
+
+10 format (A11)
+
+end program
+
+
+subroutine f(b,a,n)
+ implicit none
+ logical b
+ real a(*)
+ integer n
+
+ integer i
+
+ do i = 2,n
+ a(i) = 2 * (a(i-1) + 1)
+ if (b) type*,a(i) ! test TYPE as PRINT inside one-line IF
+ enddo
+
+ return
+end subroutine
--
1.7.1
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index fb47c13..e1256bd 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1467,6 +1467,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
* Extended math intrinsics::
* Form feed as whitespace::
* TYPE as an alias for PRINT::
+* %LOC as an rvalue::
@end menu
@node Old-style kind specifications
@@ -2537,6 +2538,26 @@ TYPE *, 'hello world'
PRINT *, 'hello world'
@end smallexample
+@node %LOC as an rvalue
+@subsection %LOC as an rvalue
+@cindex LOC
+Normally @code{%LOC} is allowed only in parameter lists. However the intrinsic
+function @code{LOC} does the same thing, and is usable as the right-hand-side of
+assignments. For compatibility, GNU Fortran supports the use of @code{%LOC} as
+an alias for the builtin @code{LOC} with @option{-std=legacy}. With this
+feature enabled the following two examples are equivalent:
+
+@smallexample
+integer :: i, l
+l = %loc(i)
+call sub(l)
+@end smallexample
+
+@smallexample
+integer :: i
+call sub(%loc(i))
+@end smallexample
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 85589ee..47a4312 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2967,9 +2967,20 @@ gfc_match_rvalue (gfc_expr **result)
bool implicit_char;
gfc_ref *ref;
- m = gfc_match_name (name);
- if (m != MATCH_YES)
- return m;
+ m = gfc_match ("%%loc");
+ if (m == MATCH_YES)
+ {
+ if (!gfc_notify_std (GFC_STD_LEGACY, "%%LOC() as an rvalue at %C"))
+ return MATCH_ERROR;
+ strncpy (name, "loc", 4);
+ }
+
+ else
+ {
+ m = gfc_match_name (name);
+ if (m != MATCH_YES)
+ return m;
+ }
/* Check if the symbol exists. */
if (gfc_find_sym_tree (name, NULL, 1, &symtree))
diff --git a/gcc/testsuite/gfortran.dg/dec_loc_rval_1.f90 b/gcc/testsuite/gfortran.dg/dec_loc_rval_1.f90
new file mode 100644
index 0000000..070b8db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_loc_rval_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Test the usage of %loc as an rvalue.
+!
+program main
+implicit none
+
+integer :: i, j, k
+
+i = loc(j)
+k = %loc(j)
+
+if (i .ne. k) then
+ print *, "bad %loc value"
+ call abort()
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_loc_rval_2.f90 b/gcc/testsuite/gfortran.dg/dec_loc_rval_2.f90
new file mode 100644
index 0000000..20eeb85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_loc_rval_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+! Test warnings for usage of %loc as an rvalue without -std=legacy.
+!
+program main
+implicit none
+
+integer, volatile :: i, j, k
+
+i = loc(j)
+k = %loc(j) ! { dg-warning "Legacy Extension:" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_loc_rval_3.f03 b/gcc/testsuite/gfortran.dg/dec_loc_rval_3.f03
new file mode 100644
index 0000000..b3441b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_loc_rval_3.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Test errors for usage of %loc as an rvalue with a real standard.
+!
+program main
+implicit none
+
+integer, volatile :: i, j, k
+
+k = %loc(j) ! { dg-error "Legacy Extension:" }
+
+end
--
1.7.1
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index e1256bd..60b619f 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1468,6 +1468,7 @@ compatibility extensions along with those enabled by @option{-std=legacy}.
* Form feed as whitespace::
* TYPE as an alias for PRINT::
* %LOC as an rvalue::
+* .XOR. operator::
@end menu
@node Old-style kind specifications
@@ -2558,6 +2559,14 @@ integer :: i
call sub(%loc(i))
@end smallexample
+@node .XOR. operator
+@subsection .XOR. operator
+@cindex operators, xor
+
+GNU Fortran supports @code{.XOR.} as a logical operator with @code{-std=legacy}
+for compatibility with legacy code. @code{.XOR.} is equivalent to
+@code{.NEQV.}. That is, the output is true if and only if the inputs differ.
+
@node Extensions not implemented in GNU Fortran
@section Extensions not implemented in GNU Fortran
@@ -2582,7 +2591,6 @@ code that uses them running with the GNU Fortran compiler.
* Variable FORMAT expressions::
@c * Q edit descriptor::
@c * TYPE and ACCEPT I/O Statements::
-@c * .XOR. operator::
@c * CARRIAGECONTROL, DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers::
@c * Omitted arguments in procedure call::
* Alternate complex function syntax::
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 046028e..21af734 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -960,6 +960,19 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result)
}
break;
+ case 'x':
+ if (gfc_next_ascii_char () == 'o'
+ && gfc_next_ascii_char () == 'r'
+ && gfc_next_ascii_char () == '.')
+ {
+ if (!gfc_notify_std (GFC_STD_LEGACY, ".XOR. operator at %C"))
+ return MATCH_ERROR;
+ /* Matched ".xor." - equivalent to ".neqv.". */
+ *result = INTRINSIC_NEQV;
+ return MATCH_YES;
+ }
+ break;
+
default:
break;
}
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_xor_1.f90 b/gcc/testsuite/gfortran.dg/dec_logical_xor_1.f90
new file mode 100644
index 0000000..d10fa19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_xor_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Test logical .XOR. operator.
+!
+
+implicit none
+
+logical :: in1, in2, neqv_out, lxor_out, truth_table(2)
+integer :: i, j, ixor_out, ieor_out
+
+truth_table(1) = .true.
+truth_table(2) = .false.
+do i = 1,2
+ do j = 1,2
+ in1 = truth_table(j)
+ in2 = truth_table(i)
+
+ ! make sure logical xor works
+ neqv_out = in1 .neqv. in2
+ lxor_out = in1 .xor. in2
+
+ if ( neqv_out .neqv. lxor_out ) then
+ print *, "(",in1,in2,") .neqv.: ",neqv_out," .xor.: ",lxor_out
+ call abort()
+ endif
+
+ ! make sure we didn't break xor() intrinsic
+ ixor_out = xor(i*7, j*5)
+ ieor_out = ieor(i*7, j*5)
+
+ if ( ixor_out .ne. ieor_out ) then
+ print *, "(",in1,in2,") ieor(): ",ieor_out," xor(): ",ixor_out
+ call abort()
+ endif
+
+ enddo
+enddo
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_xor_2.f90 b/gcc/testsuite/gfortran.dg/dec_logical_xor_2.f90
new file mode 100644
index 0000000..4e43179
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_xor_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+! Test warnings for logical .XOR. operator without -std=legacy.
+!
+
+implicit none
+
+logical, volatile :: in1, in2, xor_out
+xor_out = in1 .xor. in2 ! { dg-warning ".XOR. operator" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_xor_3.f03 b/gcc/testsuite/gfortran.dg/dec_logical_xor_3.f03
new file mode 100644
index 0000000..ff029fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_xor_3.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Test errors for logical .XOR. operator with a real standard.
+!
+
+implicit none
+
+logical, volatile :: in1, in2, xor_out
+xor_out = in1 .xor. in2 ! { dg-error ".XOR. operator" }
+
+end
--
1.7.1
