diff mbox series

Fortran: passing of optional scalar arguments with VALUE attribute [PR113377]

Message ID trinity-7003a662-7e08-4df2-a685-bb3e793e3167-1705787929716@3c-app-gmx-bs19
State Unresolved
Headers
Series Fortran: passing of optional scalar arguments with VALUE attribute [PR113377] |

Checks

Context Check Description
snail/gcc-patch-check warning Git am fail log

Commit Message

Harald Anlauf Jan. 20, 2024, 9:58 p.m. UTC 
  Dear all,

here's the first part of an attempt to fix issues with optional
dummy arguments as actual arguments to optional dummies.  This patch
rectifies the case of scalar dummies with the VALUE attribute,
which in gfortran's argument passing convention are passed on the
stack when they are of intrinsic type, and have a hidden variable
for the presence status.

The testcase tries to cover valid combinations of actual and dummy
argument.  A few tests that are not standard-conforming but would
still work with gfortran (due to the argument passing convention)
are left there but commented out with a pointer to the standard
(thanks, Mikael!).

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

Comments

Mikael Morin Jan. 21, 2024, 10:50 a.m. UTC | #1 
Hello,

Le 20/01/2024 à 22:58, Harald Anlauf a écrit :
> Dear all,
> 
> here's the first part of an attempt to fix issues with optional
> dummy arguments as actual arguments to optional dummies.  This patch
> rectifies the case of scalar dummies with the VALUE attribute,
> which in gfortran's argument passing convention are passed on the
> stack when they are of intrinsic type, and have a hidden variable
> for the presence status.
> 
> The testcase tries to cover valid combinations of actual and dummy
> argument.  A few tests that are not standard-conforming but would
> still work with gfortran (due to the argument passing convention)
> are left there but commented out with a pointer to the standard
> (thanks, Mikael!).
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
Well, not yet.

> 
> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index 9dd1f4086f4..2f47a75955c 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc
> @@ -6526,6 +6526,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>  			    gfc_init_se (&argse, NULL);
>  			    argse.want_pointer = 1;
>  			    gfc_conv_expr (&argse, e);
> +			    if (e->symtree->n.sym->attr.dummy
> +				&& POINTER_TYPE_P (TREE_TYPE (argse.expr)))
> +			      argse.expr = gfc_build_addr_expr (NULL_TREE,
> +								argse.expr);

The second part of the condition looks superfluous: if 
argse.want_pointer was set, we can expect to get a pointer result.

But more important, I don't understand the need for this whole part, the 
new test seems to pass without it.
And here is an example that regresses with it.

program p
   type :: t
     integer, allocatable :: c
   end type
   call s2(t())
contains
   subroutine s1(a)
     integer, value, optional :: a
     if (present(a)) stop 1
   end subroutine
   subroutine s2(a)
     type(t) :: a
     call s1(a%c)
   end subroutine
end program


>  			    cond = fold_convert (TREE_TYPE (argse.expr),
>  						 null_pointer_node);
>  			    cond = fold_build2_loc (input_location, NE_EXPR,
> @@ -7256,6 +7260,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>  	      && e->symtree->n.sym->attr.optional
>  	      && (((e->rank != 0 && elemental_proc)
>  		   || e->representation.length || e->ts.type == BT_CHARACTER
> +		   || (e->rank == 0 && e->symtree->n.sym->attr.value)

This looks good.

>  		   || (e->rank != 0
>  		       && (fsym == NULL
>  			   || (fsym->as
> diff --git a/gcc/testsuite/gfortran.dg/optional_absent_9.f90 b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
> new file mode 100644
> index 00000000000..495a6c00d7f
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
> @@ -0,0 +1,324 @@
> +! { dg-do run }
> +! PR fortran/113377
> +!
> +! Test passing of missing optional scalar dummies of intrinsic type
> +
> +module m_int
> +  implicit none
> +contains
> +  subroutine test_int ()
> +    integer :: k = 1
> +    call one     (k)
> +    call one_val (k)
> +    call one_all (k)
> +    call one_ptr (k)
> +  end
> +
> +  subroutine one (i, j)
> +    integer, intent(in)           :: i
> +    integer             ,optional :: j
> +    integer, allocatable :: aa
> +    integer, pointer     :: pp => NULL()
> +    if (present (j)) error stop "j is present"
> +    call two     (i, j)
> +    call two_val (i, j)
> +    call two     (i, aa)
> +    call two     (i, pp)

To be complete, you could check two_val(i, aa) and two_val(i, pp) as well.
Both seem to pass already without the patch, so not absolutely needed.
Your call.

> +  end
> +

I think the patch is OK with the first trans-expr.cc hunk removed.
Thanks.

Mikael
Harald Anlauf Jan. 21, 2024, 8:41 p.m. UTC | #2 
Hi Mikael!

Am 21.01.24 um 11:50 schrieb Mikael Morin:
> Hello,
> 
> Le 20/01/2024 à 22:58, Harald Anlauf a écrit :
>> Dear all,
>>
>> here's the first part of an attempt to fix issues with optional
>> dummy arguments as actual arguments to optional dummies.  This patch
>> rectifies the case of scalar dummies with the VALUE attribute,
>> which in gfortran's argument passing convention are passed on the
>> stack when they are of intrinsic type, and have a hidden variable
>> for the presence status.
>>
>> The testcase tries to cover valid combinations of actual and dummy
>> argument.  A few tests that are not standard-conforming but would
>> still work with gfortran (due to the argument passing convention)
>> are left there but commented out with a pointer to the standard
>> (thanks, Mikael!).
>>
>> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>>
> Well, not yet.
> 
>>
>> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
>> index 9dd1f4086f4..2f47a75955c 100644
>> --- a/gcc/fortran/trans-expr.cc
>> +++ b/gcc/fortran/trans-expr.cc
>> @@ -6526,6 +6526,10 @@ gfc_conv_procedure_call (gfc_se * se, 
>> gfc_symbol * sym,
>>                  gfc_init_se (&argse, NULL);
>>                  argse.want_pointer = 1;
>>                  gfc_conv_expr (&argse, e);
>> +                if (e->symtree->n.sym->attr.dummy
>> +                && POINTER_TYPE_P (TREE_TYPE (argse.expr)))
>> +                  argse.expr = gfc_build_addr_expr (NULL_TREE,
>> +                                argse.expr);
> 
> The second part of the condition looks superfluous: if 
> argse.want_pointer was set, we can expect to get a pointer result.
> 
> But more important, I don't understand the need for this whole part, the 
> new test seems to pass without it.
> And here is an example that regresses with it.
> 
> program p
>    type :: t
>      integer, allocatable :: c
>    end type
>    call s2(t())
> contains
>    subroutine s1(a)
>      integer, value, optional :: a
>      if (present(a)) stop 1
>    end subroutine
>    subroutine s2(a)
>      type(t) :: a
>      call s1(a%c)
>    end subroutine
> end program

Thanks for this example!  I've taken the liberty to add a slightly
extended version of it to the testcase.

I was taken astray by the attempt to handle the (invalid by the
standard) variant of passing an absent allocatable scalar to
an optional scalar dummy with the value attribute under since
we use a hidden variable for the present status.  Without the
code above there is an unprotected pointer dereference.

I think that it still could be done, but it is probably not worth
it.  So I followed your suggestion and removed that part.

> 
>>                  cond = fold_convert (TREE_TYPE (argse.expr),
>>                           null_pointer_node);
>>                  cond = fold_build2_loc (input_location, NE_EXPR,
>> @@ -7256,6 +7260,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol 
>> * sym,
>>            && e->symtree->n.sym->attr.optional
>>            && (((e->rank != 0 && elemental_proc)
>>             || e->representation.length || e->ts.type == BT_CHARACTER
>> +           || (e->rank == 0 && e->symtree->n.sym->attr.value)
> 
> This looks good.
> 
>>             || (e->rank != 0
>>                 && (fsym == NULL
>>                 || (fsym->as
>> diff --git a/gcc/testsuite/gfortran.dg/optional_absent_9.f90 
>> b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
>> new file mode 100644
>> index 00000000000..495a6c00d7f
>> --- /dev/null
>> +++ b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
>> @@ -0,0 +1,324 @@
>> +! { dg-do run }
>> +! PR fortran/113377
>> +!
>> +! Test passing of missing optional scalar dummies of intrinsic type
>> +
>> +module m_int
>> +  implicit none
>> +contains
>> +  subroutine test_int ()
>> +    integer :: k = 1
>> +    call one     (k)
>> +    call one_val (k)
>> +    call one_all (k)
>> +    call one_ptr (k)
>> +  end
>> +
>> +  subroutine one (i, j)
>> +    integer, intent(in)           :: i
>> +    integer             ,optional :: j
>> +    integer, allocatable :: aa
>> +    integer, pointer     :: pp => NULL()
>> +    if (present (j)) error stop "j is present"
>> +    call two     (i, j)
>> +    call two_val (i, j)
>> +    call two     (i, aa)
>> +    call two     (i, pp)
> 
> To be complete, you could check two_val(i, aa) and two_val(i, pp) as well.
> Both seem to pass already without the patch, so not absolutely needed.
> Your call.

It is already contained in testcase gfortran.dg/value_optional_1.f90,
(see call sub there), but then it may be helpful to have it here too.
Thus added.

>> +  end
>> +
> 
> I think the patch is OK with the first trans-expr.cc hunk removed.
> Thanks.

That's what I have done and pushed as r14-8317-g68862e5c75ef0e.

> Mikael

Thanks for the review!

Harald
diff mbox series

Patch

From f6a65138391c902d2782973665059d7d059a50d1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 20 Jan 2024 22:18:02 +0100
Subject: [PATCH] Fortran: passing of optional scalar arguments with VALUE
 attribute [PR113377]

gcc/fortran/ChangeLog:

	PR fortran/113377
	* trans-expr.cc (gfc_conv_procedure_call): Fix handling of optional
	scalar arguments of intrinsic type with the VALUE attribute.

gcc/testsuite/ChangeLog:

	PR fortran/113377
	* gfortran.dg/optional_absent_9.f90: New test.
---
 gcc/fortran/trans-expr.cc                     |   5 +
 .../gfortran.dg/optional_absent_9.f90         | 324 ++++++++++++++++++
 2 files changed, 329 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_9.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9dd1f4086f4..2f47a75955c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6526,6 +6526,10 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			    gfc_init_se (&argse, NULL);
 			    argse.want_pointer = 1;
 			    gfc_conv_expr (&argse, e);
+			    if (e->symtree->n.sym->attr.dummy
+				&& POINTER_TYPE_P (TREE_TYPE (argse.expr)))
+			      argse.expr = gfc_build_addr_expr (NULL_TREE,
+								argse.expr);
 			    cond = fold_convert (TREE_TYPE (argse.expr),
 						 null_pointer_node);
 			    cond = fold_build2_loc (input_location, NE_EXPR,
@@ -7256,6 +7260,7 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      && e->symtree->n.sym->attr.optional
 	      && (((e->rank != 0 && elemental_proc)
 		   || e->representation.length || e->ts.type == BT_CHARACTER
+		   || (e->rank == 0 && e->symtree->n.sym->attr.value)
 		   || (e->rank != 0
 		       && (fsym == NULL
 			   || (fsym->as
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_9.f90 b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
new file mode 100644
index 00000000000..495a6c00d7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_9.f90
@@ -0,0 +1,324 @@ 
+! { dg-do run }
+! PR fortran/113377
+!
+! Test passing of missing optional scalar dummies of intrinsic type
+
+module m_int
+  implicit none
+contains
+  subroutine test_int ()
+    integer :: k = 1
+    call one     (k)
+    call one_val (k)
+    call one_all (k)
+    call one_ptr (k)
+  end
+
+  subroutine one (i, j)
+    integer, intent(in)           :: i
+    integer             ,optional :: j
+    integer, allocatable :: aa
+    integer, pointer     :: pp => NULL()
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+    call two     (i, aa)
+    call two     (i, pp)
+  end
+
+  subroutine one_val (i, j)
+    integer, intent(in)           :: i
+    integer, value,      optional :: j
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+  end
+
+  subroutine one_all (i, j)
+    integer, intent(in)           :: i
+    integer, allocatable,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 8
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+    call two_all (i, j)
+  end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+  subroutine one_ptr (i, j)
+    integer, intent(in)           :: i
+    integer, pointer    ,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 7
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+    call two_ptr (i, j)
+  end
+
+  subroutine two (i, j)
+    integer, intent(in)           :: i
+    integer, intent(in), optional :: j
+    if (present (j)) error stop 11
+  end
+
+  subroutine two_val (i, j)
+    integer, intent(in)           :: i
+    integer, value,      optional :: j
+    if (present (j)) error stop 12
+  end
+
+  subroutine two_all (i, j)
+    integer, intent(in)           :: i
+    integer, allocatable,optional :: j
+    if (present (j)) error stop 13
+  end
+
+  subroutine two_ptr (i, j)
+    integer, intent(in)           :: i
+    integer, pointer,    optional :: j
+    if (present (j)) error stop 14
+  end
+end
+
+module m_char
+  implicit none
+contains
+  subroutine test_char ()
+    character :: k = "#"
+    call one     (k)
+    call one_val (k)
+    call one_all (k)
+    call one_ptr (k)
+  end
+
+  subroutine one (i, j)
+    character, intent(in)           :: i
+    character             ,optional :: j
+    character, allocatable :: aa
+    character, pointer     :: pp => NULL()
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+    call two     (i, aa)
+    call two     (i, pp)
+  end
+
+  subroutine one_val (i, j)
+    character, intent(in)           :: i
+    character, value,      optional :: j
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+  end
+
+  subroutine one_all (i, j)
+    character, intent(in)           :: i
+    character, allocatable,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 8
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+    call two_all (i, j)
+  end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+  subroutine one_ptr (i, j)
+    character, intent(in)           :: i
+    character, pointer    ,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 7
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+    call two_ptr (i, j)
+  end
+
+  subroutine two (i, j)
+    character, intent(in)           :: i
+    character, intent(in), optional :: j
+    if (present (j)) error stop 21
+  end
+
+  subroutine two_val (i, j)
+    character, intent(in)           :: i
+    character, value,      optional :: j
+    if (present (j)) error stop 22
+  end
+
+  subroutine two_all (i, j)
+    character, intent(in)           :: i
+    character, allocatable,optional :: j
+    if (present (j)) error stop 23
+  end
+
+  subroutine two_ptr (i, j)
+    character, intent(in)           :: i
+    character, pointer,    optional :: j
+    if (present (j)) error stop 24
+  end
+end
+
+module m_char4
+  implicit none
+contains
+  subroutine test_char4 ()
+    character(kind=4) :: k = 4_"#"
+    call one     (k)
+    call one_val (k)
+    call one_all (k)
+    call one_ptr (k)
+  end
+
+  subroutine one (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4)             ,optional :: j
+    character(kind=4), allocatable :: aa
+    character(kind=4), pointer     :: pp => NULL()
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+    call two     (i, aa)
+    call two     (i, pp)
+  end
+
+  subroutine one_val (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), value,      optional :: j
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+  end
+
+  subroutine one_all (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), allocatable,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 8
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+    call two_all (i, j)
+  end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! INTEGER, LOGICAL, REAL, COMPLEX, and CHARACTER(KIND=4)(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+  subroutine one_ptr (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), pointer    ,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 7
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+    call two_ptr (i, j)
+  end
+
+  subroutine two (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), intent(in), optional :: j
+    if (present (j)) error stop 31
+  end
+
+  subroutine two_val (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), value,      optional :: j
+    if (present (j)) error stop 32
+  end
+
+  subroutine two_all (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), allocatable,optional :: j
+    if (present (j)) error stop 33
+  end
+
+  subroutine two_ptr (i, j)
+    character(kind=4), intent(in)           :: i
+    character(kind=4), pointer,    optional :: j
+    if (present (j)) error stop 34
+  end
+end
+
+module m_complex
+  implicit none
+contains
+  subroutine test_complex ()
+    complex :: k = 3.
+    call one     (k)
+    call one_val (k)
+    call one_all (k)
+    call one_ptr (k)
+  end
+
+  subroutine one (i, j)
+    complex, intent(in)           :: i
+    complex             ,optional :: j
+    complex, allocatable :: aa
+    complex, pointer     :: pp => NULL()
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+    call two     (i, aa)
+    call two     (i, pp)
+  end
+
+  subroutine one_val (i, j)
+    complex, intent(in)           :: i
+    complex, value,      optional :: j
+    if (present (j)) error stop "j is present"
+    call two     (i, j)
+    call two_val (i, j)
+  end
+
+  subroutine one_all (i, j)
+    complex, intent(in)           :: i
+    complex, allocatable,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 8
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 8
+    call two_all (i, j)
+  end
+! (*) gfortran argument passing conventions ("scalar dummy arguments of type
+! COMPLEX, LOGICAL, REAL, COMPLEX, and CHARACTER(len=1) with VALUE attribute
+! pass the presence status separately") may still allow this case pass
+
+  subroutine one_ptr (i, j)
+    complex, intent(in)           :: i
+    complex, pointer    ,optional :: j
+    if (present (j)) error stop "j is present"
+!   call two     (i, j)  ! invalid per F2018:15.5.2.12, par. 3, clause 7
+!   call two_val (i, j)  ! invalid (*) F2018:15.5.2.12, par. 3, clause 7
+    call two_ptr (i, j)
+  end
+
+  subroutine two (i, j)
+    complex, intent(in)           :: i
+    complex, intent(in), optional :: j
+    if (present (j)) error stop 41
+  end
+
+  subroutine two_val (i, j)
+    complex, intent(in)           :: i
+    complex, value,      optional :: j
+    if (present (j)) error stop 42
+  end
+
+  subroutine two_all (i, j)
+    complex, intent(in)           :: i
+    complex, allocatable,optional :: j
+    if (present (j)) error stop 43
+  end
+
+  subroutine two_ptr (i, j)
+    complex, intent(in)           :: i
+    complex, pointer,    optional :: j
+    if (present (j)) error stop 44
+  end
+end
+
+program p
+  use m_int
+  use m_char
+  use m_char4
+  use m_complex
+  implicit none
+  call test_int ()
+  call test_char ()
+  call test_char4 ()
+  call test_complex ()
+end
--
2.35.3