Re: [PATCH] PR fortran/99112 - [11 Regression] ICE with runtime diagnostics for SIZE intrinsic function

2021-03-13 Thread Paul Richard Thomas via Fortran
Hi Harald,

I am not sure of the etiquette for this - it looks OK to me :-)

Cheers

Paul


On Fri, 12 Mar 2021 at 21:20, Harald Anlauf via Fortran 
wrote:

> Dear all,
>
> the addition of runtime checks for the SIZE intrinsic created a regression
> that showed up for certain CLASS arguments to procedures.  Paul did most of
> the work (~ 99%), but asked me to dig into an issue with an inappropriately
> selected error message.  This actually turned out to be a simple one-liner
> on top of Paul's patch.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> Thanks,
> Harald
>
> P.S.: I couldn't find a Changelog entry that uses co-authors.  Is the
> version
> below correct?
>
>
> PR fortran/99112 - ICE with runtime diagnostics for SIZE intrinsic function
>
> Add/fix handling of runtime checks for CLASS arguments with ALLOCATABLE
> or POINTER attribute.
>
> gcc/fortran/ChangeLog:
>
> * trans-expr.c (gfc_conv_procedure_call): Fix runtime checks for
> CLASS arguments.
> * trans-intrinsic.c (gfc_conv_intrinsic_size): Likewise.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/pr99112.f90: New test.
>
> Co-authored-by: Paul Thomas  
>
>

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


12 PR fixed

2021-03-13 Thread Steve Kargl via Fortran
The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013,
96025, 97122, 99256, 99349, 99351, and 99506.  Most of the individual
patches are languishing in bugzilla.  One or two needed to reformatted
due to divergences in main and my local repository.  Please commit.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..63138cfa9bc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k)
 static bool
 variable_check (gfc_expr *e, int n, bool allow_proc)
 {
+  /* Expecting a variable, not an alternate return.  */
+  if (!e)
+{
+  gfc_error ("%qs argument of %qs intrinsic must be a variable",
+gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic);
+  return false;
+}
+
   if (e->expr_type == EXPR_VARIABLE
   && e->symtree->n.sym->attr.intent == INTENT_IN
   && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 947e4f868a1..9039c9dca2a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result)
   /* If a parameter inquiry ends up here, symtree is NULL but **result
 contains the right constant expression.  Check here.  */
   if ((*result)->symtree == NULL
- && (*result)->expr_type == EXPR_CONSTANT
- && ((*result)->ts.type == BT_INTEGER
- || (*result)->ts.type == BT_REAL))
+ && (*result)->expr_type == EXPR_CONSTANT)
return m;
 
   /* F2018:R845 data-stmt-constant is initial-data-target.
@@ -1772,12 +1770,6 @@ gfc_set_constant_character_len (gfc_charlen_t len, 
gfc_expr *expr,
   if (expr->ts.type != BT_CHARACTER)
 return;
 
-  if (expr->expr_type != EXPR_CONSTANT)
-{
-  gfc_error_now ("CHARACTER length must be a constant at %L", 
&expr->where);
-  return;
-}
-
   slen = expr->value.character.length;
   if (len != slen)
 {
@@ -11495,8 +11487,9 @@ gfc_match_final_decl (void)
   block = gfc_state_stack->previous->sym;
   gcc_assert (block);
 
-  if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous
-  || gfc_state_stack->previous->previous->state != COMP_MODULE)
+  if (!gfc_state_stack->previous->previous
+  && gfc_state_stack->previous->previous->state != COMP_MODULE
+  && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
 {
   gfc_error ("Derived type declaration with FINAL at %C must be in the"
 " specification part of a MODULE");
@@ -11505,7 +11498,6 @@ gfc_match_final_decl (void)
 
   module_ns = gfc_current_ns;
   gcc_assert (module_ns);
-  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
 
   /* Match optional ::, don't care about MATCH_YES or MATCH_NO.  */
   if (gfc_match (" ::") == MATCH_ERROR)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 92a6700568d..e1acc2db000 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e)
 {
   gfc_error ("Expression at %L must be of INTEGER type, found %s",
 &e->where, gfc_basic_typename (e->ts.type));
+  gfc_clear_ts (&e->ts);
   return false;
 }
 
@@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr 
*rvalue,
   int proc_pointer;
   bool same_rank;
 
+  if (!lvalue->symtree)
+return false;
+
   lhs_attr = gfc_expr_attr (lvalue);
   if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
 {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 4d5890fd523..86aabf4a840 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
   gfc_matching_procptr_assignment = 0;
 
   m = gfc_match (" %v =>", &lvalue);
-  if (m != MATCH_YES)
+  if (m != MATCH_YES || !lvalue->symtree)
 {
   m = MATCH_NO;
   goto cleanup;
@@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st)
  stat = tmp;
  saw_stat = true;
 
+ if (tmp->symtree
+ && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+ || tmp->symtree->n.sym->ts.type != BT_INTEGER))
+   {
+ gfc_error ("Expecting scalar-int-variable at %L",
+&tmp->where);
+ goto cleanup;
+   }
+
  if (gfc_match_char (',') == MATCH_YES)
continue;
 
@@ -3884,6 +3893,16 @@ sync_statement (gfc_statement st)
  gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
  goto cleanup;
}
+
+ if (tmp->symtree
+ && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+ || tmp->symtree->n.sym->ts.type != BT_CHARACTER))
+   {
+ gfc_error ("Expecting scalar-default-char-variable at %L",
+&tmp->where);
+ goto cleanup;
+   }
+
  errmsg = tmp;
  saw_er

Re: 12 PR fixed

2021-03-13 Thread Jerry DeLisle

I have reviewed this and all looks good.

I also regression tested on x86_64-pc-linux-gnu.

I don't want to do a bunch of individual commits.

Steve, if you can do a ChangeLog I can commit in one blast.

Regards,

Jerry

On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote:

The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013,
96025, 97122, 99256, 99349, 99351, and 99506.  Most of the individual
patches are languishing in bugzilla.  One or two needed to reformatted
due to divergences in main and my local repository.  Please commit.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..63138cfa9bc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k)
  static bool
  variable_check (gfc_expr *e, int n, bool allow_proc)
  {
+  /* Expecting a variable, not an alternate return.  */
+  if (!e)
+{
+  gfc_error ("%qs argument of %qs intrinsic must be a variable",
+gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic);
+  return false;
+}
+
if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.intent == INTENT_IN
&& (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 947e4f868a1..9039c9dca2a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result)
/* If a parameter inquiry ends up here, symtree is NULL but **result
 contains the right constant expression.  Check here.  */
if ((*result)->symtree == NULL
- && (*result)->expr_type == EXPR_CONSTANT
- && ((*result)->ts.type == BT_INTEGER
- || (*result)->ts.type == BT_REAL))
+ && (*result)->expr_type == EXPR_CONSTANT)
return m;
  
/* F2018:R845 data-stmt-constant is initial-data-target.

@@ -1772,12 +1770,6 @@ gfc_set_constant_character_len (gfc_charlen_t len, 
gfc_expr *expr,
if (expr->ts.type != BT_CHARACTER)
  return;
  
-  if (expr->expr_type != EXPR_CONSTANT)

-{
-  gfc_error_now ("CHARACTER length must be a constant at %L", 
&expr->where);
-  return;
-}
-
slen = expr->value.character.length;
if (len != slen)
  {
@@ -11495,8 +11487,9 @@ gfc_match_final_decl (void)
block = gfc_state_stack->previous->sym;
gcc_assert (block);
  
-  if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous

-  || gfc_state_stack->previous->previous->state != COMP_MODULE)
+  if (!gfc_state_stack->previous->previous
+  && gfc_state_stack->previous->previous->state != COMP_MODULE
+  && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
  {
gfc_error ("Derived type declaration with FINAL at %C must be in the"
 " specification part of a MODULE");
@@ -11505,7 +11498,6 @@ gfc_match_final_decl (void)
  
module_ns = gfc_current_ns;

gcc_assert (module_ns);
-  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
  
/* Match optional ::, don't care about MATCH_YES or MATCH_NO.  */

if (gfc_match (" ::") == MATCH_ERROR)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 92a6700568d..e1acc2db000 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e)
  {
gfc_error ("Expression at %L must be of INTEGER type, found %s",
 &e->where, gfc_basic_typename (e->ts.type));
+  gfc_clear_ts (&e->ts);
return false;
  }
  
@@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,

int proc_pointer;
bool same_rank;
  
+  if (!lvalue->symtree)

+return false;
+
lhs_attr = gfc_expr_attr (lvalue);
if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
  {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 4d5890fd523..86aabf4a840 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
gfc_matching_procptr_assignment = 0;
  
m = gfc_match (" %v =>", &lvalue);

-  if (m != MATCH_YES)
+  if (m != MATCH_YES || !lvalue->symtree)
  {
m = MATCH_NO;
goto cleanup;
@@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st)
  stat = tmp;
  saw_stat = true;
  
+	  if (tmp->symtree

+ && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+ || tmp->symtree->n.sym->ts.type != BT_INTEGER))
+   {
+ gfc_error ("Expecting scalar-int-variable at %L",
+&tmp->where);
+ goto cleanup;
+   }
+
  if (gfc_match_char (',') == MATCH_YES)
continue;
  
@@ -3884,6 +3893,16 @@ sync_statement (gfc_statement st)

  gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
  goto cleanup;
}
+
+ if (tmp->symtree
+ && (tmp-

Re: 12 PR fixed

2021-03-13 Thread Jerry DeLisle
Well, I am seeing the falling upon a closer look.  I do not know if 
related to the patch yet.  Lets make sure this is fixed.


FAIL: gfortran.dg/pr87907.f90   -O  (internal compiler error)
FAIL: gfortran.dg/pr87907.f90   -O  (test for excess errors)
FAIL: gfortran.dg/pr96013.f90   -O  (test for excess errors)
FAIL: gfortran.dg/pr96025.f90   -O  (internal compiler error)
FAIL: gfortran.dg/pr96025.f90   -O   (test for errors, line 5)
FAIL: gfortran.dg/pr96025.f90   -O  (test for excess errors)


On 3/13/21 8:46 PM, Jerry DeLisle wrote:

I have reviewed this and all looks good.

I also regression tested on x86_64-pc-linux-gnu.

I don't want to do a bunch of individual commits.

Steve, if you can do a ChangeLog I can commit in one blast.

Regards,

Jerry

On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote:

The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013,
96025, 97122, 99256, 99349, 99351, and 99506.  Most of the individual
patches are languishing in bugzilla.  One or two needed to reformatted
due to divergences in main and my local repository.  Please commit.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..63138cfa9bc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k)
  static bool
  variable_check (gfc_expr *e, int n, bool allow_proc)
  {
+  /* Expecting a variable, not an alternate return.  */
+  if (!e)
+    {
+  gfc_error ("%qs argument of %qs intrinsic must be a variable",
+ gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic);
+  return false;
+    }
+
    if (e->expr_type == EXPR_VARIABLE
    && e->symtree->n.sym->attr.intent == INTENT_IN
    && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 947e4f868a1..9039c9dca2a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result)
    /* If a parameter inquiry ends up here, symtree is NULL but 
**result

   contains the right constant expression.  Check here.  */
    if ((*result)->symtree == NULL
-  && (*result)->expr_type == EXPR_CONSTANT
-  && ((*result)->ts.type == BT_INTEGER
-  || (*result)->ts.type == BT_REAL))
+  && (*result)->expr_type == EXPR_CONSTANT)
  return m;
      /* F2018:R845 data-stmt-constant is initial-data-target.
@@ -1772,12 +1770,6 @@ gfc_set_constant_character_len (gfc_charlen_t 
len, gfc_expr *expr,

    if (expr->ts.type != BT_CHARACTER)
  return;
  -  if (expr->expr_type != EXPR_CONSTANT)
-    {
-  gfc_error_now ("CHARACTER length must be a constant at %L", 
&expr->where);

-  return;
-    }
-
    slen = expr->value.character.length;
    if (len != slen)
  {
@@ -11495,8 +11487,9 @@ gfc_match_final_decl (void)
    block = gfc_state_stack->previous->sym;
    gcc_assert (block);
  -  if (!gfc_state_stack->previous || 
!gfc_state_stack->previous->previous

-  || gfc_state_stack->previous->previous->state != COMP_MODULE)
+  if (!gfc_state_stack->previous->previous
+  && gfc_state_stack->previous->previous->state != COMP_MODULE
+  && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
  {
    gfc_error ("Derived type declaration with FINAL at %C must be 
in the"

   " specification part of a MODULE");
@@ -11505,7 +11498,6 @@ gfc_match_final_decl (void)
      module_ns = gfc_current_ns;
    gcc_assert (module_ns);
-  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
      /* Match optional ::, don't care about MATCH_YES or MATCH_NO.  */
    if (gfc_match (" ::") == MATCH_ERROR)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 92a6700568d..e1acc2db000 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e)
  {
    gfc_error ("Expression at %L must be of INTEGER type, found %s",
   &e->where, gfc_basic_typename (e->ts.type));
+  gfc_clear_ts (&e->ts);
    return false;
  }
  @@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, 
gfc_expr *rvalue,

    int proc_pointer;
    bool same_rank;
  +  if (!lvalue->symtree)
+    return false;
+
    lhs_attr = gfc_expr_attr (lvalue);
    if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
  {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 4d5890fd523..86aabf4a840 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
    gfc_matching_procptr_assignment = 0;
      m = gfc_match (" %v =>", &lvalue);
-  if (m != MATCH_YES)
+  if (m != MATCH_YES || !lvalue->symtree)
  {
    m = MATCH_NO;
    goto cleanup;
@@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st)
    stat = tmp;
    saw_stat = true;
  +  if (tmp->symtree
+  && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+  || tmp->symtree->n.sym

Re: 12 PR fixed

2021-03-13 Thread Steve Kargl via Fortran
On Sat, Mar 13, 2021 at 09:13:53PM -0800, Jerry DeLisle wrote:
> Well, I am seeing the falling upon a closer look.  I do not know if related
> to the patch yet.  Lets make sure this is fixed.
> 
> FAIL: gfortran.dg/pr87907.f90   -O  (internal compiler error)
> FAIL: gfortran.dg/pr87907.f90   -O  (test for excess errors)
> FAIL: gfortran.dg/pr96013.f90   -O  (test for excess errors)
> FAIL: gfortran.dg/pr96025.f90   -O  (internal compiler error)
> FAIL: gfortran.dg/pr96025.f90   -O   (test for errors, line 5)
> FAIL: gfortran.dg/pr96025.f90   -O  (test for excess errors)

On my system,

=== gfortran Summary ===

# of expected passes56305
# of expected failures  232
# of unsupported tests  109
/home/kargl/gcc/obj/gcc/gfortran  version 11.0.1 20210313 (experimental) (GCC) 

AFAIK, my tree is up-to-date, but then again, git is a foreign
beast to me.  Too bad that the people responsible for the switch
to git throw 15 years of corporate knowledge for little gain.

I see what I can do for a ChangeLog.  Some of my patches have
lingered in bugzilla for too long.  I don't remember all of 
the details.

-- 
steve