* [Patch] Fortran: Fixes for pointer function call as variable (PR96896)
@ 2020-09-02 15:02 Tobias Burnus
2020-09-07 9:38 ` *PING* " Tobias Burnus
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2020-09-02 15:02 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 928 bytes --]
During some discussion such an example as attached came up:
f() = 0.0
where 'f' is a function which returns a pointer to an array.
This gets handled as
_F.D0 => f()
_F.D0 = 0.0
However, the first line did fail with a rank error as the rank
was taken from the RHS.
Changing this to the LHS express failed due to 'use_assoc',
which added an 'extern' to the variable and 'proc_pointer'
also caused problems – in principle, either problem could
have also occurred for the RHS.
Side effect: The error message is better for rank mismatch
as for 'f() = a' no pointer assignment is involved (in terms
of the user code) but before we had the error message
'Different ranks in pointer assignment'.
OK?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
[-- Attachment #2: ptrfunc.diff --]
[-- Type: text/x-patch, Size: 3600 bytes --]
Fortran: Fixes for pointer function call as variable (PR96896)
gcc/fortran/ChangeLog:
PR fortran/96896
* resolve.c (get_temp_from_expr): Also reset proc_pointer +
use_assoc attribute.
(resolve_ptr_fcn_assign): Use information from the LHS.
gcc/testsuite/ChangeLog:
PR fortran/96896
* gfortran.dg/ptr_func_assign_4.f08:
* gfortran.dg/ptr-func-3.f90: New test.
gcc/fortran/resolve.c | 4 +-
gcc/testsuite/gfortran.dg/ptr-func-3.f90 | 56 +++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08 | 4 +-
3 files changed, 61 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e4232717e42..a3e1e427ba7 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11173,9 +11173,11 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
/* Add the attributes and the arrayspec to the temporary. */
tmp->n.sym->attr = gfc_expr_attr (e);
tmp->n.sym->attr.function = 0;
+ tmp->n.sym->attr.proc_pointer = 0;
tmp->n.sym->attr.result = 0;
tmp->n.sym->attr.flavor = FL_VARIABLE;
tmp->n.sym->attr.dummy = 0;
+ tmp->n.sym->attr.use_assoc = 0;
tmp->n.sym->attr.intent = INTENT_UNKNOWN;
if (as)
@@ -11595,7 +11597,7 @@ resolve_ptr_fcn_assign (gfc_code **code, gfc_namespace *ns)
return false;
}
- tmp_ptr_expr = get_temp_from_expr ((*code)->expr2, ns);
+ tmp_ptr_expr = get_temp_from_expr ((*code)->expr1, ns);
/* get_temp_from_expression is set up for ordinary assignments. To that
end, where array bounds are not known, arrays are made allocatable.
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-3.f90 b/gcc/testsuite/gfortran.dg/ptr-func-3.f90
new file mode 100644
index 00000000000..0f1af64002a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-3.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! PR fortran/96896
+
+call test1
+call reshape_test
+end
+
+subroutine test1
+implicit none
+integer, target :: B
+integer, pointer :: A(:)
+allocate(A(5))
+A = 1
+B = 10
+get_A() = get_B()
+if (any (A /= 10)) stop 1
+get_A() = get_A()
+if (any (A /= 10)) stop 2
+deallocate(A)
+contains
+ function get_A()
+ integer, pointer :: get_A(:)
+ get_A => A
+ end
+ function get_B()
+ integer, pointer :: get_B
+ get_B => B
+ end
+end
+
+subroutine reshape_test
+ implicit none
+ real, target, dimension (1:9) :: b
+ integer :: i
+ b = 1.0
+ myshape(b) = 3.0
+ do i = 1, 3
+ myfunc (b,i,2) = b(i) + i
+ b(i) = b(i) + 2.0
+ end do
+ if (any (b /= [real::5,5,5,4,5,6,3,3,3])) stop 3
+contains
+ function myfunc(b,i,j)
+ real, target, dimension (1:9) :: b
+ real, pointer :: myfunc
+ real, pointer :: p(:,:)
+ integer :: i,j
+ p => myshape(b)
+ myfunc => p(i,j)
+ end function myfunc
+ function myshape(b)
+ real, target, dimension (1:9) :: b
+ real, pointer :: myshape(:,:)
+ myshape(1:3,1:3) => b
+ end function myshape
+end subroutine reshape_test
diff --git a/gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08 b/gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08
index 46ef2ac5566..49ba9bcd3d9 100644
--- a/gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08
+++ b/gcc/testsuite/gfortran.dg/ptr_func_assign_4.f08
@@ -10,8 +10,8 @@ program p
integer :: c
c = 3
- func (b(2, 2)) = b ! { dg-error "Different ranks" }
- func (c) = b ! { dg-error "Different ranks" }
+ func (b(2, 2)) = b ! { dg-error "Incompatible ranks 1 and 2 in assignment" }
+ func (c) = b ! { dg-error "Incompatible ranks 1 and 2 in assignment" }
contains
function func(arg) result(r)
^ permalink raw reply [flat|nested] 3+ messages in thread
* *PING* [Patch] Fortran: Fixes for pointer function call as variable (PR96896)
2020-09-02 15:02 [Patch] Fortran: Fixes for pointer function call as variable (PR96896) Tobias Burnus
@ 2020-09-07 9:38 ` Tobias Burnus
2020-09-07 10:18 ` Thomas Koenig
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2020-09-07 9:38 UTC (permalink / raw)
To: gcc-patches, fortran
*PING*
On 9/2/20 5:02 PM, Tobias Burnus wrote:
> During some discussion such an example as attached came up:
> f() = 0.0
> where 'f' is a function which returns a pointer to an array.
> This gets handled as
> _F.D0 => f()
> _F.D0 = 0.0
> However, the first line did fail with a rank error as the rank
> was taken from the RHS.
>
> Changing this to the LHS express failed due to 'use_assoc',
> which added an 'extern' to the variable and 'proc_pointer'
> also caused problems – in principle, either problem could
> have also occurred for the RHS.
>
> Side effect: The error message is better for rank mismatch
> as for 'f() = a' no pointer assignment is involved (in terms
> of the user code) but before we had the error message
> 'Different ranks in pointer assignment'.
>
> OK?
>
> Tobias
>
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: *PING* [Patch] Fortran: Fixes for pointer function call as variable (PR96896)
2020-09-07 9:38 ` *PING* " Tobias Burnus
@ 2020-09-07 10:18 ` Thomas Koenig
0 siblings, 0 replies; 3+ messages in thread
From: Thomas Koenig @ 2020-09-07 10:18 UTC (permalink / raw)
To: Tobias Burnus, gcc-patches, fortran
Hi Tobias,
> *PING*
OK.
Thanks for the patch!
Regards
Thomas
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2020-09-07 10:18 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-09-02 15:02 [Patch] Fortran: Fixes for pointer function call as variable (PR96896) Tobias Burnus
2020-09-07 9:38 ` *PING* " Tobias Burnus
2020-09-07 10:18 ` Thomas Koenig
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).