From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp-26.smtpout.orange.fr [80.12.242.26]) by sourceware.org (Postfix) with ESMTPS id 9CED83858D20 for ; Sat, 4 Mar 2023 13:56:32 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 9CED83858D20 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=orange.fr Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=orange.fr Received: from [192.168.1.16] ([86.215.161.51]) by smtp.orange.fr with ESMTPA id YSN2pFwGoPE2VYSN7pQudH; Sat, 04 Mar 2023 14:56:29 +0100 X-ME-Helo: [192.168.1.16] X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Sat, 04 Mar 2023 14:56:29 +0100 X-ME-IP: 86.215.161.51 Message-ID: <5f1e8202-303e-5da2-c42b-8eab00a12a97@orange.fr> Date: Sat, 4 Mar 2023 14:56:20 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.8.0 Subject: Re: [PATCH] Fortran: fix CLASS attribute handling [PR106856] From: Mikael Morin To: sgk@troutmask.apl.washington.edu, Harald Anlauf via Fortran Cc: gcc-patches , tobias@codesourcery.com References: <5b42f0b7-e217-555d-b1f2-4b623f3ae150@orange.fr> Content-Language: en-US In-Reply-To: <5b42f0b7-e217-555d-b1f2-4b623f3ae150@orange.fr> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.2 required=5.0 tests=BAYES_00,FREEMAIL_FROM,GIT_PATCH_0,JMQ_SPF_NEUTRAL,KAM_DMARC_STATUS,NICE_REPLY_A,RCVD_IN_DNSWL_NONE,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: Le 03/03/2023 à 22:24, Mikael Morin a écrit : > > I have two comments, one about the handling of as and sym->as, which I > quite don't understand, but I haven't had time to write something about it. I have found the time finally. It's not as bad as it seemed. See below. > diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc > index eec0314cf4c..72d8c6f1c14 100644 > --- a/gcc/fortran/decl.cc > +++ b/gcc/fortran/decl.cc > @@ -8740,45 +8740,23 @@ attr_decl1 (void) > } > } > > - /* Update symbol table. DIMENSION attribute is set in > - gfc_set_array_spec(). For CLASS variables, this must be applied > - to the first component, or '_data' field. */ > if (sym->ts.type == BT_CLASS > && sym->ts.u.derived > && sym->ts.u.derived->attr.is_class) > { > - /* gfc_set_array_spec sets sym->attr not CLASS_DATA(sym)->attr. Check > - for duplicate attribute here. */ > - if (CLASS_DATA(sym)->attr.dimension == 1 && as) > - { > - gfc_error ("Duplicate DIMENSION attribute at %C"); > - m = MATCH_ERROR; > - goto cleanup; > - } > - > - if (!gfc_copy_attr (&CLASS_DATA(sym)->attr, ¤t_attr, &var_locus)) > - { > - m = MATCH_ERROR; > - goto cleanup; > - } > + sym->attr.pointer = CLASS_DATA(sym)->attr.class_pointer; > + sym->attr.allocatable = CLASS_DATA(sym)->attr.allocatable; > + sym->attr.dimension = CLASS_DATA(sym)->attr.dimension; > + sym->attr.codimension = CLASS_DATA(sym)->attr.codimension; > + if (as && CLASS_DATA (sym)->as) > + sym->as = gfc_copy_array_spec (CLASS_DATA (sym)->as); Here the condition on 'CLASS_DATA(sym)->as' makes obviously sense, but I don't see why there is also a condition on 'as'. For example, if the array spec has been previously set on the class container's first component, and there is no array spec information in the current statement (i.e. as == NULL), sym->as will remain NULL, and a non-array class container will be built in gfc_build_class_symbol below. > } > - else > - { > - if (current_attr.dimension == 0 && current_attr.codimension == 0 > - && !gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus)) > - { > - m = MATCH_ERROR; > - goto cleanup; > - } > - } > - > - if (sym->ts.type == BT_CLASS > - && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as)) > + if (current_attr.dimension == 0 && current_attr.codimension == 0 > + && !gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus)) > { > m = MATCH_ERROR; > goto cleanup; > } > - > if (!gfc_set_array_spec (sym, as, &var_locus)) > { > m = MATCH_ERROR; > @@ -8807,6 +8785,27 @@ attr_decl1 (void) > goto cleanup; > } > > + if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class > + && !as && !current_attr.pointer && !current_attr.allocatable > + && !current_attr.external) > + { > + sym->attr.pointer = 0; > + sym->attr.allocatable = 0; > + sym->attr.dimension = 0; > + sym->attr.codimension = 0; > + gfc_free_array_spec (sym->as); sym->as should probably be reset to NULL here. Maybe both calls to gfc_free_array_spec here and to gfc_copy_array_spec above can be avoided by doing a simple pointer copy? > + } > + else if (sym->ts.type == BT_CLASS > + && !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as)) > + { > + m = MATCH_ERROR; > + goto cleanup; > + } > + else if (sym->ts.type == BT_CLASS > + && sym->ts.u.derived->attr.is_class > + && sym->old_symbol && sym->old_symbol->as == CLASS_DATA (sym)->as) > + sym->old_symbol->as = NULL; > + > add_hidden_procptr_result (sym); > > return MATCH_YES;