The attached patch issues errors for a few mangled type-specs.
It has been regression tested on x86_64-*-freebsd. OK to commit?
2019-09-28 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91714
* decl.c (gfc_match_decl_type_spec): Issue errors for a few
mangled types.
2019-09-28 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91714
* gfortran.dg/dec_type_print_3.f90: Update dg-error regex.
* gfortran.dg/pr91714.f90: New test.
A daunting task awaits a brave soul as gfc_match_decl_type_spec
is a minefield for bugs. This is dues to the fact the the functions
has grown by adding kludge upon kludge upon kludge. The first
thing to fix is the broken parsing that follows from the
matching of 'type('.
--
Steve
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 276254)
+++ gcc/fortran/decl.c (working copy)
@@ -4444,6 +4444,7 @@ get_kind:
gfc_next_ascii_char ();
return MATCH_YES;
}
+ gfc_error ("Malformed type-spec at %C");
return MATCH_NO;
}
}
@@ -4457,7 +4458,10 @@ get_kind:
}
if (matched_type && gfc_match_char (')') != MATCH_YES)
- return MATCH_ERROR;
+ {
+ gfc_error ("Malformed type-spec at %C");
+ return MATCH_ERROR;
+ }
/* Defer association of the KIND expression of function results
until after USE and IMPORT statements. */
@@ -10240,6 +10244,20 @@ gfc_match_derived_decl (void)
return MATCH_ERROR;
}
+ /* In free source form, need to check for TYPE XXX as oppose to TYPEXXX.
+ But, we need to simply return for TYPE(. */
+ if (m == MATCH_NO && gfc_current_form == FORM_FREE)
+ {
+ char c = gfc_peek_ascii_char ();
+ if (c == '(')
+ return m;
+ if (!gfc_is_whitespace (c))
+ {
+ gfc_error ("Mangled derived type definition at %C");
+ return MATCH_NO;
+ }
+ }
+
m = gfc_match (" %n ", name);
if (m != MATCH_YES)
return m;
@@ -10247,7 +10265,7 @@ gfc_match_derived_decl (void)
/* Make sure that we don't identify TYPE IS (...) as a parameterized
derived type named 'is'.
TODO Expand the check, when 'name' = "is" by matching " (tname) "
- and checking if this is a(n intrinsic) typename. his picks up
+ and checking if this is a(n intrinsic) typename. This picks up
misplaced TYPE IS statements such as in select_type_1.f03. */
if (gfc_peek_ascii_char () == '(')
{
Index: gcc/testsuite/gfortran.dg/dec_type_print_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dec_type_print_3.f90 (revision 276253)
+++ gcc/testsuite/gfortran.dg/dec_type_print_3.f90 (working copy)
@@ -8,9 +8,9 @@
include 'dec_type_print.f90'
-! { dg-error "Invalid character in name" "" { target *-*-* } 52 }
+! { dg-error "Mangled derived type definition" "" { target *-*-* } 52 }
! { dg-error "Invalid character in name" "" { target *-*-* } 53 }
-! { dg-error "Invalid character in name" "" { target *-*-* } 54 }
+! { dg-error "Mangled derived type definition" "" { target *-*-* } 54 }
! { dg-error "Invalid character in name" "" { target *-*-* } 55 }
! { dg-error "Invalid character in name" "" { target *-*-* } 56 }
! { dg-error "Invalid character in name" "" { target *-*-* } 57 }
Index: gcc/testsuite/gfortran.dg/pr91714.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr91714.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91714.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Contributed by Gerhard Steinmetz
+program p
+ typea ! { dg-error "Mangled derived type" }
+ integer b
+ end type ! { dg-error "Expecting END PROGRAM" }
+ type(a) :: c ! { dg-error "is being used before it" }
+ c = a(1)
+ print *, c
+end
