diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 94 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.texi | 16 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/match.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 6 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dec_type_print.f90 | 84 |
8 files changed, 218 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d3971a63610..986eedfde2a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2016-10-25 Fritz Reese <fritzoreese@gmail.com> + * 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. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + * gfortran.texi: Document. * gfortran.h (gfc_is_whitespace): Include form feed ('\f'). diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e47d8ede33c..6c9d0570df7 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 688b9565e26..fb47c13ceaa 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 aa9961c6ed5..236231e3ee6 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 24131635713..eeb26931567 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 03234358547..760d3afdb5f 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/ChangeLog b/gcc/testsuite/ChangeLog index b2662db6008..a64e74d91d9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,11 @@ 2016-10-25 Fritz Reese <fritzoreese@gmail.com> - gfortran.dg/ - * feed_1.f90, feed_2.f90: New testcases. + * gfortran.dg/dec_type_print.f90: New testcase. + +2016-10-25 Fritz Reese <fritzoreese@gmail.com> + + * gfortran.dg/feed_1.f90: New test. + * gfortran.dg/feed_2.f90: New test. 2016-10-25 Martin Liska <mliska@suse.cz> 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 00000000000..ca407987329 --- /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 |