public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131
@ 2021-04-22 21:21 Harald Anlauf
  2021-04-24 16:29 ` Paul Richard Thomas
  0 siblings, 1 reply; 3+ messages in thread
From: Harald Anlauf @ 2021-04-22 21:21 UTC (permalink / raw)
  To: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1300 bytes --]

Now with the correct patch attached ...

Sorry for the confusion!

---

Dear Fortranners,

we need to check the arguments to the affected GNU intrinsic extensions
properly, and - as pointed out in the PR by Tobias - we need to allow
function references that have a data pointer result.  Also the argument
names of the character arguments of the subroutine versions needed a
fix ("c" instead of "count").

Regtested on x86_64-pc-linux-gnu.  OK for mainline (12)?
OK for backports after 11.1 release?

Thanks,
Harald


PR fortran/100154 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131

Add appropriate static checks for the character and status arguments to
the GNU Fortran intrinsic extensions fget[c], fput[c].  Extend variable
check to allow a function reference having a data pointer result.

gcc/fortran/ChangeLog:

	PR fortran/100154
	* check.c (variable_check): Allow function reference having a data
	pointer result.
	(arg_strlen_is_zero): New function.
	(gfc_check_fgetputc_sub): Add static check of character and status
	arguments.
	(gfc_check_fgetput_sub): Likewise.
	* intrinsic.c (add_subroutines): Fix argument name for the
	character argument to intrinsic subroutines fget[c], fput[c].

gcc/testsuite/ChangeLog:

	PR fortran/100154
	* gfortran.dg/pr100154.f90: New test.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100154.patch --]
[-- Type: text/x-patch, Size: 6086 bytes --]

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..1d30c93df82 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1055,6 +1055,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
          return true;
     }

+  /* F2018:R902: function reference having a data pointer result.  */
+  if (e->expr_type == EXPR_FUNCTION
+      && e->symtree->n.sym->attr.flavor == FL_PROCEDURE
+      && e->symtree->n.sym->attr.function
+      && e->symtree->n.sym->attr.pointer)
+    return true;
+
   gfc_error ("%qs argument of %qs intrinsic at %L must be a variable",
             gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);

@@ -5689,6 +5691,19 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
 /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and
    functions).  */

+bool
+arg_strlen_is_zero (gfc_expr *c, int n)
+{
+  if (gfc_var_strlen (c) == 0)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must have "
+		 "length at least 1", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &c->where);
+      return true;
+    }
+  return false;
+}
+
 bool
 gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
 {
@@ -5702,13 +5717,19 @@ gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 1, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fgetc") == 0
+      && !variable_check (c, 1, false))
+    return false;
+  if (arg_strlen_is_zero (c, 1))
+    return false;

   if (status == NULL)
     return true;

   if (!type_check (status, 2, BT_INTEGER)
       || !kind_value_check (status, 2, gfc_default_integer_kind)
-      || !scalar_check (status, 2))
+      || !scalar_check (status, 2)
+      || !variable_check (status, 2, false))
     return false;

   return true;
@@ -5729,13 +5750,19 @@ gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 0, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fget") == 0
+      && !variable_check (c, 0, false))
+    return false;
+  if (arg_strlen_is_zero (c, 0))
+    return false;

   if (status == NULL)
     return true;

   if (!type_check (status, 1, BT_INTEGER)
       || !kind_value_check (status, 1, gfc_default_integer_kind)
-      || !scalar_check (status, 1))
+      || !scalar_check (status, 1)
+      || !variable_check (status, 1, false))
     return false;

   return true;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 17fd92eb462..219f04f2317 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3460,7 +3460,7 @@ add_subroutines (void)
   /* Argument names.  These are used as argument keywords and so need to
      match the documentation.  Please keep this list in sorted order.  */
   static const char
-    *a = "a", *c = "count", *cm = "count_max", *com = "command",
+    *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
     *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
     *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
     *length = "length", *ln = "len", *md = "mode", *msk = "mask",
@@ -3840,12 +3840,12 @@ add_subroutines (void)
   add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
@@ -3855,12 +3855,12 @@ add_subroutines (void)
   add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
diff --git a/gcc/testsuite/gfortran.dg/pr100154.f90 b/gcc/testsuite/gfortran.dg/pr100154.f90
new file mode 100644
index 00000000000..3a1489aaab8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100154.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+! PR100154 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131
+
+program p
+  implicit none
+  integer           :: n
+  character, target :: c
+  character(len=0)  :: c0
+  character(len=:), allocatable :: cc
+  n = fget(cc)
+  n = fget('a')       ! { dg-error "must be a variable" }
+  n = fget(c0)        ! { dg-error "must have length at least 1" }
+  call fget('x')      ! { dg-error "must be a variable" }
+  n = fgetc(5,'a')    ! { dg-error "must be a variable" }
+  call fgetc(5,c0)    ! { dg-error "must have length at least 1" }
+  call fgetc(5,c,1)   ! { dg-error "must be a variable" }
+  call fputc(5,'x',1) ! { dg-error "must be a variable" }
+  n = fget (ptr_returning_func())
+  print *, c
+contains
+  function ptr_returning_func () result (res)
+    character, pointer :: res
+    res => c
+  end
+end

^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131
  2021-04-22 21:21 [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 Harald Anlauf
@ 2021-04-24 16:29 ` Paul Richard Thomas
  0 siblings, 0 replies; 3+ messages in thread
From: Paul Richard Thomas @ 2021-04-24 16:29 UTC (permalink / raw)
  To: Harald Anlauf; +Cc: fortran, gcc-patches

Hi Harald,

It looks good to me! Keep clear of 11-branch until release but OK for the
others.

Thanks

Paul


On Fri, 23 Apr 2021 at 00:18, Harald Anlauf via Fortran <fortran@gcc.gnu.org>
wrote:

> Now with the correct patch attached ...
>
> Sorry for the confusion!
>
> ---
>
> Dear Fortranners,
>
> we need to check the arguments to the affected GNU intrinsic extensions
> properly, and - as pointed out in the PR by Tobias - we need to allow
> function references that have a data pointer result.  Also the argument
> names of the character arguments of the subroutine versions needed a
> fix ("c" instead of "count").
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline (12)?
> OK for backports after 11.1 release?
>
> Thanks,
> Harald
>
>
> PR fortran/100154 - ICE in gfc_conv_procedure_call, at
> fortran/trans-expr.c:6131
>
> Add appropriate static checks for the character and status arguments to
> the GNU Fortran intrinsic extensions fget[c], fput[c].  Extend variable
> check to allow a function reference having a data pointer result.
>
> gcc/fortran/ChangeLog:
>
>         PR fortran/100154
>         * check.c (variable_check): Allow function reference having a data
>         pointer result.
>         (arg_strlen_is_zero): New function.
>         (gfc_check_fgetputc_sub): Add static check of character and status
>         arguments.
>         (gfc_check_fgetput_sub): Likewise.
>         * intrinsic.c (add_subroutines): Fix argument name for the
>         character argument to intrinsic subroutines fget[c], fput[c].
>
> gcc/testsuite/ChangeLog:
>
>         PR fortran/100154
>         * gfortran.dg/pr100154.f90: New test.
>
>

-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

^ permalink raw reply	[flat|nested] 3+ messages in thread

* [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131
@ 2021-04-22 21:05 Harald Anlauf
  0 siblings, 0 replies; 3+ messages in thread
From: Harald Anlauf @ 2021-04-22 21:05 UTC (permalink / raw)
  To: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1228 bytes --]

Dear Fortranners,

we need to check the arguments to the affected GNU intrinsic extensions
properly, and - as pointed out in the PR by Tobias - we need to allow
function references that have a data pointer result.  Also the argument
names of the character arguments of the subroutine versions needed a
fix ("c" instead of "count").

Regtested on x86_64-pc-linux-gnu.  OK for mainline (12)?
OK for backports after 11.1 release?

Thanks,
Harald


PR fortran/100154 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131

Add appropriate static checks for the character and status arguments to
the GNU Fortran intrinsic extensions fget[c], fput[c].  Extend variable
check to allow a function reference having a data pointer result.

gcc/fortran/ChangeLog:

	PR fortran/100154
	* check.c (variable_check): Allow function reference having a data
	pointer result.
	(arg_strlen_is_zero): New function.
	(gfc_check_fgetputc_sub): Add static check of character and status
	arguments.
	(gfc_check_fgetput_sub): Likewise.
	* intrinsic.c (add_subroutines): Fix argument name for the
	character argument to intrinsic subroutines fget[c], fput[c].

gcc/testsuite/ChangeLog:

	PR fortran/100154
	* gfortran.dg/pr100154.f90: New test.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100154-wip.patch --]
[-- Type: text/x-patch, Size: 4401 bytes --]

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..1d30c93df82 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -5689,6 +5691,19 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
 /* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and
    functions).  */

+bool
+arg_strlen_is_zero (gfc_expr *c, int n)
+{
+  if (gfc_var_strlen (c) == 0)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must have "
+		 "length at least 1", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &c->where);
+      return true;
+    }
+  return false;
+}
+
 bool
 gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
 {
@@ -5702,13 +5717,19 @@ gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 1, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fgetc") == 0
+      && !variable_check (c, 1, false))
+    return false;
+  if (arg_strlen_is_zero (c, 1))
+    return false;

   if (status == NULL)
     return true;

   if (!type_check (status, 2, BT_INTEGER)
       || !kind_value_check (status, 2, gfc_default_integer_kind)
-      || !scalar_check (status, 2))
+      || !scalar_check (status, 2)
+      || !variable_check (status, 2, false))
     return false;

   return true;
@@ -5729,13 +5750,19 @@ gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 0, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fget") == 0
+      && !variable_check (c, 0, false))
+    return false;
+  if (arg_strlen_is_zero (c, 0))
+    return false;

   if (status == NULL)
     return true;

   if (!type_check (status, 1, BT_INTEGER)
       || !kind_value_check (status, 1, gfc_default_integer_kind)
-      || !scalar_check (status, 1))
+      || !scalar_check (status, 1)
+      || !variable_check (status, 1, false))
     return false;

   return true;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 17fd92eb462..219f04f2317 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3460,7 +3460,7 @@ add_subroutines (void)
   /* Argument names.  These are used as argument keywords and so need to
      match the documentation.  Please keep this list in sorted order.  */
   static const char
-    *a = "a", *c = "count", *cm = "count_max", *com = "command",
+    *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
     *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
     *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
     *length = "length", *ln = "len", *md = "mode", *msk = "mask",
@@ -3840,12 +3840,12 @@ add_subroutines (void)
   add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
@@ -3855,12 +3855,12 @@ add_subroutines (void)
   add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);

   add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,

^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2021-04-24 16:29 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-04-22 21:21 [Patch] PR fortran/100154 - [9/10/11/12 Regression] ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 Harald Anlauf
2021-04-24 16:29 ` Paul Richard Thomas
  -- strict thread matches above, loose matches on Subject: below --
2021-04-22 21:05 Harald Anlauf

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).