pr59016

[Evangelos Drikos <drikosev@otenet.gr>]

[-- Attachment #1: Type: text/plain, Size: 716 bytes --]


Hi,

The attached patch, type 0, has been discussed a little at:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=59016

Yet, the final version submitted is slightly different from the ones discussed and tested in the above link.

Having read the GNU Coding Conventions, I created a patch using svn diff (“-up”) and I added a small test case.

Further, I've run the “check_GNU_style.sh” script to ensure that the source code meets the GNU style requirements. 

Also, I don’t have DejaGNU installed and thus I think that I cannot run all the tests. In other words, evaluation is up to the GNU team.

Finally, it might be obvious that the patch is for trunk (not gcc-4.9.2).

Regards,
Ev. Drikos 




[-- Attachment #2: gcc-5.0-pr59016.c_log --]
[-- Type: application/octet-stream, Size: 604 bytes --]

gcc/fortran/ChangeLog:

2015-04-06  Ev. Drikoss  <drikosev@otenet.gr>

	PR fortran/59016
	* decl.c (gfc_match_decl_type_spec): save old
	generic values in two additional arguments.
	(gfc_match_implicit): pass two more aguments.
	(gfc_match_data_decl): pass two more aguments;
	cleanup, if a declaration type spec is erroneous.
	(gfc_match_prefix): pass two more aguments.
	(match_procedure_interface): pass two more args.
	*match.h: add two args in function declaration.

gcc/testsuite/ChangeLog:

2015-04-06  Ev. Drikos  <drikosev@otenet.gr>

	PR fortran/59016
	* gfortran.dg/pr59016.f90:  New test.
	


[-- Attachment #3: gcc-5.0-pr59016.patch --]
[-- Type: application/octet-stream, Size: 5326 bytes --]

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 221872)
+++ gcc/fortran/decl.c	(working copy)
@@ -2601,7 +2601,8 @@ done:
    statement correctly.  */
 
 match
-gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
+gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag,
+						  gfc_symbol** ifunlink,gfc_interface** old_generic)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symbol *sym, *dt_sym;
@@ -2897,8 +2898,11 @@ gfc_match_decl_type_spec (gfc_typespec *
       intr->sym = dt_sym;
       intr->where = gfc_current_locus;
       intr->next = head;
+      *old_generic = sym->generic;
       sym->generic = intr;
       sym->attr.if_source = IFSRC_DECL;
+      *ifunlink=sym;
+
     }
 
   gfc_set_sym_referenced (dt_sym);
@@ -3167,7 +3171,8 @@ gfc_match_implicit (void)
       gfc_clear_new_implicit ();
 
       /* A basic type is mandatory here.  */
-      m = gfc_match_decl_type_spec (&ts, 1);
+      gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL;
+      m = gfc_match_decl_type_spec (&ts, 1, &ifunlink,&old_generic);
       if (m == MATCH_ERROR)
 	goto error;
       if (m == MATCH_NO)
@@ -4341,8 +4346,8 @@ gfc_match_data_decl (void)
   int elem;
 
   num_idents_on_line = 0;
-
-  m = gfc_match_decl_type_spec (&current_ts, 0);
+  gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL;
+  m = gfc_match_decl_type_spec (&current_ts, 0,&ifunlink,&old_generic);
   if (m != MATCH_YES)
     return m;
 
@@ -4427,6 +4432,40 @@ ok:
   gfc_free_data_all (gfc_current_ns);
 
 cleanup:
+  //<pr59016> in gfc_match_data_decl; cleanup the garbages
+  gfc_symbol *csym=NULL;
+  if ( (m==MATCH_ERROR)       //clean only if stmt not matched and
+  &&   (ifunlink!=NULL)     //the symbol was indeed linked in chain.
+  &&   (current_ts.u.derived &&
+		current_ts.u.derived->name))
+  {
+      const char *pname = current_ts.u.derived->name;
+      //In case the dt name is in title instead of lower case.
+      if ( current_ts.u.derived->name[0] !=
+		   TOLOWER (current_ts.u.derived->name[0]))
+	  {
+		  char iname[129]; iname[128]=0;
+		  for (int i=0; (i < 128);i++)
+		  {
+			  iname[i]=current_ts.u.derived->name[i];
+			  if (current_ts.u.derived->name[i]==0)
+				  break;
+		  }//for
+		  iname[0] = TOLOWER (iname[0]);
+		  pname    = iname ;
+	  }//if
+	  for (int i=0; i<4;i++) {  //try iface=0, 1, 2, and 3
+		  gfc_find_symbol (pname, NULL, i, &csym) ;
+		  if ( csym && csym->generic &&
+			 ( csym->generic->sym == current_ts.u.derived))
+		  {
+			  ifunlink->generic->next=csym->generic->next;	//remove from chain
+			  csym->generic = old_generic;					//restore old value
+			  break;
+		  }//if
+	  }//for
+  }//if
+  //</pr59016>
   gfc_free_array_spec (current_as);
   current_as = NULL;
   return m;
@@ -4455,9 +4494,10 @@ gfc_match_prefix (gfc_typespec *ts)
   do
     {
       found_prefix = false;
+      gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL;
 
       if (!seen_type && ts != NULL
-	  && gfc_match_decl_type_spec (ts, 0) == MATCH_YES
+	  && gfc_match_decl_type_spec (ts, 0,&ifunlink,&old_generic) == MATCH_YES
 	  && gfc_match_space () == MATCH_YES)
 	{
 
@@ -4888,7 +4928,8 @@ match_procedure_interface (gfc_symbol **
 
   /* Get the type spec. for the procedure interface.  */
   old_loc = gfc_current_locus;
-  m = gfc_match_decl_type_spec (&current_ts, 0);
+  gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL;
+  m = gfc_match_decl_type_spec (&current_ts, 0,&ifunlink,&old_generic);
   gfc_gobble_whitespace ();
   if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_ascii_char () == ')'))
     goto got_ts;
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 221872)
+++ gcc/fortran/match.h	(working copy)
@@ -193,7 +193,8 @@ match gfc_match_data (void);
 match gfc_match_null (gfc_expr **);
 match gfc_match_kind_spec (gfc_typespec *, bool);
 match gfc_match_old_kind_spec (gfc_typespec *);
-match gfc_match_decl_type_spec (gfc_typespec *, int);
+match gfc_match_decl_type_spec (gfc_typespec *,
+								int,gfc_symbol**,gfc_interface**);
 
 match gfc_match_end (gfc_statement *);
 match gfc_match_data_decl (void);
Index: gcc/testsuite/gfortran.dg/pr59016.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr59016.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/pr59016.f90	(working copy)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/59016
+!
+! Check cleanup.
+!
+! Contributed by Evangelos Drikos.
+!
+
+MODULE atomic_kind_types
+  PUBLIC :: atomic_kind_type,&
+            dft_plus_u_type
+CONTAINS
+  SUBROUTINE get_atomic_kind_set(atomic_kind_set,maxatom,maxcgf,&
+       zetsoft_max,basis_set_id)
+       CALL stop_program(routineN,moduleN,__LINE__,&              ! { dg-error "Syntax error in argument list" }
+            "The pointer atomic_kind_set is not associated")
+  END SUBROUTINE get_atomic_kind_set
+  PURE FUNCTION is_hydrogen(atomic_kind) RESULT(res)              ! { dg-error "must be INTENT(IN) or VALUE" }
+    TYPE(atomic_kind_type), POINTER          :: atomic_kind       ! { dg-error "is being used before it is defined" }
+  END FUNCTION is_hydrogen
+END MODULE atomic_kind_types
+