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 <fritzore...@gmail.com> 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 <fritzore...@gmail.com> 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 <fritzore...@gmail.com> 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 <fritzore...@gmail.com> 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 <fritzore...@gmail.com> 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