diff mbox series

[Fortran] Fix PR 24878, checking actual arguments against global symbols

Message ID e238e999-7f38-4727-8595-4b84218d9b3e@netcologne.de
State New
Headers
Series [Fortran] Fix PR 24878, checking actual arguments against global symbols |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm success Build passed
linaro-tcwg-bot/tcwg_gcc_check--master-arm success Test passed
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 success Build passed
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-aarch64-bootstrap success Build passed
linaro-tcwg-bot/tcwg_gcc_check--master-aarch64 success Test passed
linaro-tcwg-bot/tcwg_simplebootstrap_build--master-arm-bootstrap success Build passed

Commit Message

Thomas Koenig Feb. 8, 2025, 2:31 p.m. UTC 
  Hello world,

this fixes a rather old PR from 2005, where a subroutine
could be passed and called as a function.  This patch checks
for that, also for the reverse, and for wrong types of functions.

I expect that this will find a few bugs in dusty deck code...

Regression-tested. OK for trunk?

Best regards

	Thomas

Test procedure dummy arguments against global symbols, if available.

gcc/fortran/ChangeLog:

	PR fortran/24878
	* interface.cc (compare_parameter): Check global subroutines
	passed as actual arguments for subroutine / function and
	function type.

gcc/testsuite/ChangeLog:

	PR fortran/24878
	* gfortran.dg/interface_51.f90: New test.

Comments

Harald Anlauf Feb. 8, 2025, 9:46 p.m. UTC | #1 
Hi Thomas,

Am 08.02.25 um 15:31 schrieb Thomas Koenig:
> Hello world,
>
> this fixes a rather old PR from 2005, where a subroutine
> could be passed and called as a function.  This patch checks
> for that, also for the reverse, and for wrong types of functions.

looks good, just two minor comments:

+      actual_name = act_sym->name ? act_sym->name : act_sym->name;

Why not just

+      actual_name = act_sym->name;

?


+			  gfc_error ("Type mismatch passing global function %qs "
+				     "declared at %L at %L (%s/%s)", actual_name,
+				     &gsym->where, &actual->where,
+				     gfc_typename (&global_asym->ts),
+				     gfc_dummy_typename (&formal->ts));

These result in lines exceeding column 80.

I am also not a native speaker, but "at %L at %L" sounds strange to me.
Could you find a minor rewording?

> I expect that this will find a few bugs in dusty deck code...

... we'll see ... ;-)

> Regression-tested. OK for trunk?

OK.  Thanks for the patch!

Harald

> Best regards
>
>      Thomas
>
> Test procedure dummy arguments against global symbols, if available.
>
> gcc/fortran/ChangeLog:
>
>      PR fortran/24878
>      * interface.cc (compare_parameter): Check global subroutines
>      passed as actual arguments for subroutine / function and
>      function type.
>
> gcc/testsuite/ChangeLog:
>
>      PR fortran/24878
>      * gfortran.dg/interface_51.f90: New test.
Thomas Koenig Feb. 9, 2025, 8:54 a.m. UTC | #2 
Am 08.02.25 um 22:46 schrieb Harald Anlauf:
> looks good, just two minor comments:
> 
> +      actual_name = act_sym->name ? act_sym->name : act_sym->name;
> 
> Why not just
> 
> +      actual_name = act_sym->name;
> 
> ?

That was a leftover from a previous commit.

> 
> 
> +              gfc_error ("Type mismatch passing global function %qs "
> +                     "declared at %L at %L (%s/%s)", actual_name,
> +                     &gsym->where, &actual->where,
> +                     gfc_typename (&global_asym->ts),
> +                     gfc_dummy_typename (&formal->ts));
> 
> These result in lines exceeding column 80.

Fixed.

> I am also not a native speaker, but "at %L at %L" sounds strange to me.
> Could you find a minor rewording?

I tried, but I could not find anything better...

So, if anybody can think of a more clever wording, the patch for
this is pre-approved :-)

Committed as r15-7449, thanks for the review!

Best regards

	Thomas
Thomas Koenig Feb. 10, 2025, 8:31 p.m. UTC | #3 
Am 09.02.25 um 20:24 schrieb Jerry D:
> 
> "Type mismatch at %L when passing global function %qs "
>   "declared at %L (%s/%s)"

Committed as r15-7460-gd2ff1b78d70731db1b7adc1cbac7e44688828370 .

Thanks for the help with the wording!

Best regards

	Thomas
diff mbox series

Patch

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 145f710563a..9ab5544454a 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2423,6 +2423,7 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   gfc_component *ppc;
   bool codimension = false;
   gfc_array_spec *formal_as;
+  const char *actual_name;
 
   /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
      procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -2487,6 +2488,51 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  return false;
 	}
 
+      /* The actual symbol may disagree with a global symbol.  If so, issue an
+	 error, but only if no previous error has been reported on the formal
+	 argument.  */
+      actual_name = act_sym->name ? act_sym->name : act_sym->name;
+      if (!formal->error && actual_name)
+	{
+	  gfc_gsymbol *gsym;
+	  gsym = gfc_find_gsymbol (gfc_gsym_root, actual_name);
+	  if (gsym != NULL)
+	    {
+	      if (gsym->type == GSYM_SUBROUTINE && formal->attr.function)
+		{
+		  gfc_error ("Passing global subroutine %qs declared at %L "
+			     "as function at %L", actual_name, &gsym->where,
+			     &actual->where);
+		  return false;
+		}
+	      if (gsym->type == GSYM_FUNCTION && formal->attr.subroutine)
+		{
+		  gfc_error ("Passing global function %qs declared at %L "
+			     "as subroutine at %L", actual_name, &gsym->where,
+			     &actual->where);
+		  return false;
+		}
+	      if (gsym->type == GSYM_FUNCTION)
+		{
+		  gfc_symbol *global_asym;
+		  gfc_find_symbol (actual_name, gsym->ns, 0, &global_asym);
+		  if (global_asym != NULL)
+		    {
+		      gcc_assert (formal->attr.function);
+		      if (!gfc_compare_types (&global_asym->ts, &formal->ts))
+			{
+			  gfc_error ("Type mismatch passing global function %qs "
+				     "declared at %L at %L (%s/%s)", actual_name,
+				     &gsym->where, &actual->where,
+				     gfc_typename (&global_asym->ts),
+				     gfc_dummy_typename (&formal->ts));
+			  return false;
+			}
+		    }
+		}
+	    }
+	}
+
       if (formal->attr.function && !act_sym->attr.function)
 	{
 	  gfc_add_function (&act_sym->attr, act_sym->name,
@@ -2501,7 +2547,6 @@  compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
       return true;
     }
-
   ppc = gfc_get_proc_ptr_comp (actual);
   if (ppc && ppc->ts.interface)
     {
diff --git a/gcc/testsuite/gfortran.dg/interface_51.f90 b/gcc/testsuite/gfortran.dg/interface_51.f90
new file mode 100644
index 00000000000..c8371e81ec9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_51.f90
@@ -0,0 +1,51 @@ 
+! { dg-do compile }
+
+! PR 24878 - passing a global subroutine as a function, or vice versa,
+! was not caught, nor were type mismatches.  Original test case by
+! Uttam Pawar.
+
+program memain
+  implicit none
+  integer subr
+  external subr
+  external i4
+  external r4
+  integer r4
+  
+  call foo(subr) ! { dg-error "Passing global subroutine" }
+  call bar(i4)   ! { dg-error "Passing global function" }
+  call baz(r4)   ! { dg-error "Type mismatch passing global function" }
+end program memain
+
+subroutine foo(ifun)
+  integer(kind=4) ifun
+  external ifun
+  integer y
+!---FNC is not a Function subprogram so calling it
+!   as a function is an error.
+  Y=ifun(32)
+end subroutine foo
+
+subroutine bar(sub)
+  call sub
+end subroutine bar
+
+subroutine subr(X) ! { dg-error "Passing global subroutine" }
+  integer x
+  x = 12345
+end subroutine subr
+
+integer(kind=4) function i4() ! { dg-error "Passing global function" }
+  i4 = 42
+end function i4
+
+real(kind=4) function r4() ! { dg-error "Type mismatch passing global function" }
+  r4 = 1.0
+end function r4
+  
+subroutine baz(ifun)
+  integer(kind=4) ifun
+  external ifun
+  integer y
+  y = ifun(32)
+end subroutine baz