From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id C89F9385772C; Fri, 2 Jun 2023 18:05:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C89F9385772C Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1685729154; x=1686333954; i=anlauf@gmx.de; bh=0oGNZ+eiGafQlTQ69t1+l9AapsUQCffFusYAi02Zwq0=; h=X-UI-Sender-Class:From:To:Subject:Date; b=ec9EE5vSZnDkaCu66MvPc28u+liGyPZ5mC3NA8TT6XrKQ5LeazrTG0FoavTAve0HRhgYsLL SvPYDDZWf0myzuOWLdLIg3c3juMbRxrqVjhj8cUha3BQ4bXdWLVRxhOom91e7BhF20J9NUXAe RpHJLFYggvsXaf3U/7zzxb4/wp7z8qV1zTactZ7rhhhu8jofW4VkcYMOnTWHJaPIh1nOq7DXm VIx1XGxohzeVljCro9Uziu5RuUr43gLZxG+WyX6JLaHaxRnLOHD7zR9lv3h66HLgLBXx7Inex boStfw9oQL6AG3nuMoRCjsqemC8rwW91g/OamxpjqIM8eUW5Z/+A== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.15.121] ([79.251.15.121]) by web-mail.gmx.net (3c-app-gmx-bs08.server.lan [172.19.170.59]) (via HTTP); Fri, 2 Jun 2023 20:05:54 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH, committed] Fortran: fix diagnostics for SELECT RANK [PR100607] Content-Type: multipart/mixed; boundary=rekceb-67269371-23c7-446f-b192-3c7e8dc9a2cd Date: Fri, 2 Jun 2023 20:05:54 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:l/HNOZ9QWzdR8h/AzOYj9til000i5XbG2I4yg1t+YdCC6S2gqJCDwWIOx04XoP0UcE2Lv C3qGE0qwcdARBcvdlKyItJ5VnglYo2MEhMg+8MsUwzH0U0VfzYr10ObuHjewKb+wz5E9K66mQ6PG fcs+//REs6H3Atu5OmWC13kPP0SqQIDxoPE3nErA2wyqtuT7q6VMOxn+4Iw4Jbm6jHGjNfTRJUMy SiOCLw2ik2lnIjCEYONp/3whPmSMDmpUZ5SWBHgLTwnlvxXPkyAplBm2kRFYSZ5/f+4rh33PbmbF eY= UI-OutboundReport: notjunk:1;M01:P0:L5xPZtHSgqQ=;e9KaV6zMyLzlY0lt3Y0s4xSboOn KWA8sl87Xj3MmfAJFnSI1pLHaXPLWo6joHfFsQqr6UPcFgDYUH9FzYoSQNnLr8pc6EHYwAy28 Q7w3jKac4+sWkltcC4Ri/cHANNRkUWhXdTjaRLn2mKFXt8ndmyoW/BkYLIofXIkyLaDeDoquP zC2O/FzDnGjaPXz6cJTBQuLKHebtJEUd7zeDOKtklLxXrkxtAKW2ZoGpOmkJMTn9p3MBsUt3h 1OXxoPantJxc3nQW2YZLRxSNjLVTNlZSzNMWRHAJBQQrBWzg/LeZfutm3HfzvyiDNRavKCeVn R3vSYO90sB9XU98/wep0k+XIZE+gXAzLGVlmHUghIpVEC9HPaCGMCWlwX+s6Tn73uVA/j098M 0qg5PVRAJCOIynFgRQ2/R+4JtIxD/FybMv1+nwZKkzkK3N7UdFRLxHskjfKbPOkdGFofINTS4 Mc9FcVe0X4sKb7HuL2tdSB6dPAc+jNOSXbJUIbzkpoQYFNU7jGyGs8E+V+FLVwWexXUDgPAXr yaqSgFukaaaVfZgGTqM4actJA1p5xZ3ejrTxsOK+CiK4c1sgnvvRjV8ByLSUJhmQOXVkbgP4H Wj9OaZEt/VsKAqtXN2Ex+EMnyr6rwmUeFDAysW412qnwBIkDjJrMBPZkqCUV1Z1Ztl/WsJ9AG v9u/dB1ZNfaPBaOpLVV3hkLnMokVuCC2AcmQ33X4P9LmxjdIJhnkVqAhIlwM8ZuAZ10UKtgJP bpLDYr5XjM34XOb3sfC353W5z/70ZPqFJMwYNcolrquEZX1vKIHGj/CDIoJjskOCty+ukY+CO F6PzknhPUSErkBwmEKSR1k0IT7GmWOcDzbl2ajCVI7hZ8= X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H5,RCVD_IN_MSPIKE_WL,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE 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: --rekceb-67269371-23c7-446f-b192-3c7e8dc9a2cd Content-Type: text/plain; charset=UTF-8 Dear all, I've committed that attached simple patch on behalf of Steve after discussion in the PR and regtesting on x86_64-pc-linux-gnu. It fixes a duplicate error message and an ICE. Pushed as r14-1505-gfae09dfc0e6bf4cfe35d817558827aea78c6426f . Thanks, Harald --rekceb-67269371-23c7-446f-b192-3c7e8dc9a2cd Content-Type: text/x-patch Content-Disposition: attachment; filename=pr100607.diff Content-Transfer-Encoding: quoted-printable =46rom fae09dfc0e6bf4cfe35d817558827aea78c6426f Mon Sep 17 00:00:00 2001 From: Steve Kargl Date: Fri, 2 Jun 2023 19:44:11 +0200 Subject: [PATCH] Fortran: fix diagnostics for SELECT RANK [PR100607] gcc/fortran/ChangeLog: PR fortran/100607 * resolve.cc (resolve_select_rank): Remove duplicate error. (resolve_fl_var_and_proc): Prevent NULL pointer dereference and suppress error message for temporary. gcc/testsuite/ChangeLog: PR fortran/100607 * gfortran.dg/select_rank_6.f90: New test. =2D-- gcc/fortran/resolve.cc | 10 ++--- gcc/testsuite/gfortran.dg/select_rank_6.f90 | 48 +++++++++++++++++++++ 2 files changed, 52 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/select_rank_6.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 2ba3101f1fe..fd059dddf05 100644 =2D-- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10020,11 +10020,6 @@ resolve_select_rank (gfc_code *code, gfc_namespac= e *old_ns) || gfc_expr_attr (code->expr1).pointer)) gfc_error ("RANK (*) at %L cannot be used with the pointer or " "allocatable selector at %L", &c->where, &code->expr1->where); - - if (case_value =3D=3D -1 && (gfc_expr_attr (code->expr1).allocatabl= e - || gfc_expr_attr (code->expr1).pointer)) - gfc_error ("RANK (*) at %L cannot be used with the pointer or " - "allocatable selector at %L", &c->where, &code->expr1->where); } /* Add EXEC_SELECT to switch on rank. */ @@ -13262,7 +13257,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_= flag) if (allocatable) { - if (dimension && as->type !=3D AS_ASSUMED_RANK) + if (dimension + && as + && as->type !=3D AS_ASSUMED_RANK + && !sym->attr.select_rank_temporary) { gfc_error ("Allocatable array %qs at %L must have a deferred " "shape or assumed rank", sym->name, &sym->declared_at); diff --git a/gcc/testsuite/gfortran.dg/select_rank_6.f90 b/gcc/testsuite/g= fortran.dg/select_rank_6.f90 new file mode 100644 index 00000000000..d0121777bb5 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_rank_6.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! PR fortran/100607 - fix diagnostics for SELECT RANK +! Contributed by T.Burnus + +program p + implicit none + integer, allocatable :: A(:,:,:) + + allocate(a(5:6,-2:2, 99:100)) + call foo(a) + call bar(a) + +contains + + subroutine foo(x) + integer, allocatable :: x(..) + if (rank(x) /=3D 3) stop 1 + if (any (lbound(x) /=3D [5, -2, 99])) stop 2 + + select rank (x) + rank(3) + if (any (lbound(x) /=3D [5, -2, 99])) stop 3 + end select + + select rank (x) ! { dg-error "pointer or allocatable selector at .2."= } + rank(*) ! { dg-error "pointer or allocatable selector at .2."= } + if (rank(x) /=3D 1) stop 4 + if (lbound(x, 1) /=3D 1) stop 5 + end select + end + + subroutine bar(x) + integer :: x(..) + if (rank(x) /=3D 3) stop 6 + if (any (lbound(x) /=3D 1)) stop 7 + + select rank (x) + rank(3) + if (any (lbound(x) /=3D 1)) stop 8 + end select + + select rank (x) + rank(*) + if (rank(x) /=3D 1) stop 9 + if (lbound(x, 1) /=3D 1) stop 10 + end select + end +end =2D- 2.35.3 --rekceb-67269371-23c7-446f-b192-3c7e8dc9a2cd--