From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 32019 invoked by alias); 5 Apr 2015 23:04:19 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 31998 invoked by uid 89); 5 Apr 2015 23:04:18 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.6 required=5.0 tests=AWL,BAYES_50,KAM_LAZY_DOMAIN_SECURITY,RCVD_IN_DNSWL_NONE,T_RP_MATCHES_RCVD autolearn=no version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: medusa.otenet.gr Received: from smtp-out31.otenet.gr (HELO medusa.otenet.gr) (83.235.69.31) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 05 Apr 2015 23:04:16 +0000 Received: from [192.168.1.13] (athedsl-4519109.home.otenet.gr [94.71.224.205]) by medusa.otenet.gr (ESMTP) with ESMTP; Mon, 6 Apr 2015 02:04:12 +0300 (EEST) From: Evangelos Drikos Content-Type: multipart/mixed; boundary="Apple-Mail=_49547527-6FC4-4027-AAD7-1C6E9FDD3CC3" Subject: pr59016 Date: Sun, 05 Apr 2015 23:04:00 -0000 Message-Id: Cc: gcc-patches@gcc.gnu.org To: fortran@gcc.gnu.org Mime-Version: 1.0 (Mac OS X Mail 7.2 \(1874\)) X-SW-Source: 2015-04/txt/msg00174.txt.bz2 --Apple-Mail=_49547527-6FC4-4027-AAD7-1C6E9FDD3CC3 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=windows-1252 Content-length: 719 Hi, The attached patch, type 0, has been discussed a little at: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=3D59016 Yet, the final version submitted is slightly different from the ones discus= sed and tested in the above link. Having read the GNU Coding Conventions, I created a patch using svn diff (= =93-up=94) and I added a small test case. Further, I've run the =93check_GNU_style.sh=94 script to ensure that the so= urce code meets the GNU style requirements.=20 Also, I don=92t have DejaGNU installed and thus I think that I cannot run a= ll 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=20 --Apple-Mail=_49547527-6FC4-4027-AAD7-1C6E9FDD3CC3 Content-Disposition: attachment; filename=gcc-5.0-pr59016.c_log Content-Type: application/octet-stream; name="gcc-5.0-pr59016.c_log" Content-Transfer-Encoding: 7bit Content-length: 604 gcc/fortran/ChangeLog: 2015-04-06 Ev. Drikoss 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 PR fortran/59016 * gfortran.dg/pr59016.f90: New test. --Apple-Mail=_49547527-6FC4-4027-AAD7-1C6E9FDD3CC3 Content-Disposition: attachment; filename=gcc-5.0-pr59016.patch Content-Type: application/octet-stream; name="gcc-5.0-pr59016.patch" Content-Transfer-Encoding: 7bit Content-length: 5326 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 (¤t_ts, 0); + gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL; + m = gfc_match_decl_type_spec (¤t_ts, 0,&ifunlink,&old_generic); if (m != MATCH_YES) return m; @@ -4427,6 +4432,40 @@ ok: gfc_free_data_all (gfc_current_ns); cleanup: + // 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 + // 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 (¤t_ts, 0); + gfc_symbol *ifunlink=NULL; gfc_interface *old_generic=NULL; + m = gfc_match_decl_type_spec (¤t_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 + --Apple-Mail=_49547527-6FC4-4027-AAD7-1C6E9FDD3CC3--