From ab77a5867b04f1c6584b9a079c971be16e57cb59 Mon Sep 17 00:00:00 2001
From: David Malcolm <dmalcolm@redhat.com>
Date: Mon, 17 Feb 2020 16:43:46 -0500
Subject: [PATCH 05/31] analyzer: fix ICE on COMPONENT_REF of ARRAY_TYPE [PR
 93778]

PR analyzer/93778 reports an ICE with -fanalyzer on a gfortran test case
at this gimple stmt:

  _gfortran_st_set_nml_var (&dt_parm.0, &ro.xi.jq, &"ro%xi%jq"[1]{lb: 1 sz: 1}, 4, 0, D.3913);

where ro.xi.jq is a COMPONENT_REF, but ro.xi is of type "struct bl[3]".

The analyzer's handling of COMPONENT_REF assumes that the type of the
1st argument is a RECORD_TYPE or UNION_TYPE, whereas in this case it's
an ARRAY_TYPE, leading to a failed as_a inside
region_model::get_field_region.

This patch fixes the ICE by generalizing the "give up on this tree code"
logic from r10-6667-gf76a88ebf089871dcce215aa0cb1956ccc060895 for
PR analyzer/93388, so that the analyzer gives up when it needs to get an
lvalue for a COMPONENT_REF on something other than a RECORD_TYPE or
UNION_TYPE.

gcc/analyzer/ChangeLog:
	PR analyzer/93778
	* engine.cc (impl_region_model_context::on_unknown_tree_code):
	Rename to...
	(impl_region_model_context::on_unexpected_tree_code): ...this and
	convert first argument from path_var to tree.
	(exploded_node::on_stmt): Pass ctxt to purge_for_unknown_fncall.
	* exploded-graph.h (region_model_context::on_unknown_tree_code):
	Rename to...
	(region_model_context::on_unexpected_tree_code): ...this and
	convert first argument from path_var to tree.
	* program-state.cc (sm_state_map::purge_for_unknown_fncall): Add
	ctxt param and pass on to calls to get_rvalue.
	* program-state.h (sm_state_map::purge_for_unknown_fncall): Add
	ctxt param.
	* region-model.cc (region_model::handle_unrecognized_call): Pass
	ctxt on to call to get_rvalue.
	(region_model::get_lvalue_1): Move body of default case to
	region_model::make_region_for_unexpected_tree_code and call it.
	Within COMPONENT_REF case, reject attempts to handle types other
	than RECORD_TYPE and UNION_TYPE.
	(region_model::make_region_for_unexpected_tree_code): New
	function, based on default case of region_model::get_lvalue_1.
	* region-model.h
	(region_model::make_region_for_unexpected_tree_code): New decl.
	(region_model::on_unknown_tree_code): Rename to...
	(region_model::on_unexpected_tree_code): ...this and convert first
	argument from path_var to tree.
	(class test_region_model_context): Update vfunc implementation for
	above change.

gcc/testsuite/ChangeLog:
	PR analyzer/93778
	* gfortran.dg/analyzer/pr93778.f90: New test.
---
 gcc/analyzer/engine.cc                        | 11 ++---
 gcc/analyzer/exploded-graph.h                 |  4 +-
 gcc/analyzer/program-state.cc                 |  9 +++--
 gcc/analyzer/program-state.h                  |  3 +-
 gcc/analyzer/region-model.cc                  | 40 ++++++++++++-------
 gcc/analyzer/region-model.h                   | 14 ++++---
 .../gfortran.dg/analyzer/pr93778.f90          | 11 +++++
 7 files changed, 61 insertions(+), 31 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/analyzer/pr93778.f90

diff --git a/gcc/analyzer/engine.cc b/gcc/analyzer/engine.cc
index cd4ffe55dc5..de6bf1d394f 100644
--- a/gcc/analyzer/engine.cc
+++ b/gcc/analyzer/engine.cc
@@ -684,18 +684,18 @@ impl_region_model_context::on_phi (const gphi *phi, tree rhs)
     }
 }
 
-/* Implementation of region_model_context::on_unknown_tree_code vfunc.
+/* Implementation of region_model_context::on_unexpected_tree_code vfunc.
    Mark the new state as being invalid for further exploration.
    TODO(stage1): introduce a warning for when this occurs.  */
 
 void
-impl_region_model_context::on_unknown_tree_code (path_var pv,
-						 const dump_location_t &loc)
+impl_region_model_context::on_unexpected_tree_code (tree t,
+						    const dump_location_t &loc)
 {
   logger * const logger = get_logger ();
   if (logger)
     logger->log ("unhandled tree code: %qs in %qs at %s:%i",
-		 get_tree_code_name (TREE_CODE (pv.m_tree)),
+		 get_tree_code_name (TREE_CODE (t)),
 		 loc.get_impl_location ().m_function,
 		 loc.get_impl_location ().m_file,
 		 loc.get_impl_location ().m_line);
@@ -1093,7 +1093,8 @@ exploded_node::on_stmt (exploded_graph &eg,
 
 	      if (!fndecl_has_gimple_body_p (callee_fndecl))
 		new_smap->purge_for_unknown_fncall (eg, sm, call, callee_fndecl,
-						    state->m_region_model);
+						    state->m_region_model,
+						    &ctxt);
 	    }
 	}
       if (*old_smap != *new_smap)
diff --git a/gcc/analyzer/exploded-graph.h b/gcc/analyzer/exploded-graph.h
index 614c37ce9af..a851dd929c9 100644
--- a/gcc/analyzer/exploded-graph.h
+++ b/gcc/analyzer/exploded-graph.h
@@ -76,8 +76,8 @@ class impl_region_model_context : public region_model_context
 
   void on_phi (const gphi *phi, tree rhs) FINAL OVERRIDE;
 
-  void on_unknown_tree_code (path_var pv,
-			     const dump_location_t &loc) FINAL OVERRIDE;
+  void on_unexpected_tree_code (tree t,
+				const dump_location_t &loc) FINAL OVERRIDE;
 
   exploded_graph *m_eg;
   log_user m_logger;
diff --git a/gcc/analyzer/program-state.cc b/gcc/analyzer/program-state.cc
index fb96e3c976b..971e8e0a7d6 100644
--- a/gcc/analyzer/program-state.cc
+++ b/gcc/analyzer/program-state.cc
@@ -380,7 +380,8 @@ sm_state_map::purge_for_unknown_fncall (const exploded_graph &eg,
 					const state_machine &sm,
 					const gcall *call,
 					tree fndecl,
-					region_model *new_model)
+					region_model *new_model,
+					region_model_context *ctxt)
 {
   logger * const logger = eg.get_logger ();
   if (logger)
@@ -413,7 +414,7 @@ sm_state_map::purge_for_unknown_fncall (const exploded_graph &eg,
 	      continue;
 	}
       tree parm = gimple_call_arg (call, arg_idx);
-      svalue_id parm_sid = new_model->get_rvalue (parm, NULL);
+      svalue_id parm_sid = new_model->get_rvalue (parm, ctxt);
       set_state (new_model, parm_sid, 0, svalue_id::null ());
 
       /* Also clear sm-state from svalue_ids that are passed via a
@@ -421,7 +422,7 @@ sm_state_map::purge_for_unknown_fncall (const exploded_graph &eg,
       if (TREE_CODE (parm) == ADDR_EXPR)
 	{
 	  tree pointee = TREE_OPERAND (parm, 0);
-	  svalue_id parm_sid = new_model->get_rvalue (pointee, NULL);
+	  svalue_id parm_sid = new_model->get_rvalue (pointee, ctxt);
 	  set_state (new_model, parm_sid, 0, svalue_id::null ());
 	}
     }
@@ -429,7 +430,7 @@ sm_state_map::purge_for_unknown_fncall (const exploded_graph &eg,
   /* Purge any state for any LHS.  */
   if (tree lhs = gimple_call_lhs (call))
     {
-      svalue_id lhs_sid = new_model->get_rvalue (lhs, NULL);
+      svalue_id lhs_sid = new_model->get_rvalue (lhs, ctxt);
       set_state (new_model, lhs_sid, 0, svalue_id::null ());
     }
 }
diff --git a/gcc/analyzer/program-state.h b/gcc/analyzer/program-state.h
index 80df649f565..2c778ccb9ac 100644
--- a/gcc/analyzer/program-state.h
+++ b/gcc/analyzer/program-state.h
@@ -179,7 +179,8 @@ public:
   void purge_for_unknown_fncall (const exploded_graph &eg,
 				 const state_machine &sm,
 				 const gcall *call, tree fndecl,
-				 region_model *new_model);
+				 region_model *new_model,
+				 region_model_context *ctxt);
 
   void remap_svalue_ids (const svalue_id_map &map);
 
diff --git a/gcc/analyzer/region-model.cc b/gcc/analyzer/region-model.cc
index 659255a8db4..c8ee031dc8f 100644
--- a/gcc/analyzer/region-model.cc
+++ b/gcc/analyzer/region-model.cc
@@ -4431,7 +4431,7 @@ region_model::handle_unrecognized_call (const gcall *call,
 	  }
 
 	tree parm = gimple_call_arg (call, arg_idx);
-	svalue_id parm_sid = get_rvalue (parm, NULL);
+	svalue_id parm_sid = get_rvalue (parm, ctxt);
 	svalue *parm_sval = get_svalue (parm_sid);
 	if (parm_sval)
 	  if (region_svalue *parm_ptr = parm_sval->dyn_cast_region_svalue ())
@@ -4641,19 +4641,8 @@ region_model::get_lvalue_1 (path_var pv, region_model_context *ctxt)
   switch (TREE_CODE (expr))
     {
     default:
-      {
-	/* If we see a tree code we we don't know how to handle, rather than
-	   ICE or generate bogus results, create a dummy region, and notify
-	   CTXT so that it can mark the new state as being not properly
-	   modelled.  The exploded graph can then stop exploring that path,
-	   since any diagnostics we might issue will have questionable
-	   validity.  */
-	region_id new_rid
-	  = add_region (new symbolic_region (m_root_rid, NULL_TREE, false));
-	ctxt->on_unknown_tree_code (pv, dump_location_t ());
-	return new_rid;
-      }
-      break;
+      return make_region_for_unexpected_tree_code (ctxt, expr,
+						   dump_location_t ());
 
     case ARRAY_REF:
       {
@@ -4730,6 +4719,11 @@ region_model::get_lvalue_1 (path_var pv, region_model_context *ctxt)
 	/* obj.field  */
 	tree obj = TREE_OPERAND (expr, 0);
 	tree field = TREE_OPERAND (expr, 1);
+	tree obj_type = TREE_TYPE (obj);
+	if (TREE_CODE (obj_type) != RECORD_TYPE
+	    && TREE_CODE (obj_type) != UNION_TYPE)
+	  return make_region_for_unexpected_tree_code (ctxt, obj_type,
+						       dump_location_t ());
 	region_id obj_rid = get_lvalue (obj, ctxt);
 	region_id struct_or_union_rid
 	  = get_or_create_view (obj_rid, TREE_TYPE (obj));
@@ -4770,6 +4764,24 @@ region_model::get_lvalue_1 (path_var pv, region_model_context *ctxt)
     }
 }
 
+/* If we see a tree code we we don't know how to handle, rather than
+   ICE or generate bogus results, create a dummy region, and notify
+   CTXT so that it can mark the new state as being not properly
+   modelled.  The exploded graph can then stop exploring that path,
+   since any diagnostics we might issue will have questionable
+   validity.  */
+
+region_id
+region_model::make_region_for_unexpected_tree_code (region_model_context *ctxt,
+						    tree t,
+						    const dump_location_t &loc)
+{
+  region_id new_rid
+    = add_region (new symbolic_region (m_root_rid, NULL_TREE, false));
+  ctxt->on_unexpected_tree_code (t, loc);
+  return new_rid;
+}
+
 /* Assert that SRC_TYPE can be converted to DST_TYPE as a no-op.  */
 
 static void
diff --git a/gcc/analyzer/region-model.h b/gcc/analyzer/region-model.h
index dc56d64a43b..3b2b43b595f 100644
--- a/gcc/analyzer/region-model.h
+++ b/gcc/analyzer/region-model.h
@@ -1835,6 +1835,10 @@ class region_model
   region_id get_lvalue_1 (path_var pv, region_model_context *ctxt);
   svalue_id get_rvalue_1 (path_var pv, region_model_context *ctxt);
 
+  region_id make_region_for_unexpected_tree_code (region_model_context *ctxt,
+						  tree t,
+						  const dump_location_t &loc);
+
   void add_any_constraints_from_ssa_def_stmt (tree lhs,
 					      enum tree_code op,
 					      tree rhs,
@@ -1939,9 +1943,9 @@ class region_model_context
   virtual void on_phi (const gphi *phi, tree rhs) = 0;
 
   /* Hooks for clients to be notified when the region model doesn't
-     know how to handle the tree code of PV at LOC.  */
-  virtual void on_unknown_tree_code (path_var pv,
-				     const dump_location_t &loc) = 0;
+     know how to handle the tree code of T at LOC.  */
+  virtual void on_unexpected_tree_code (tree t,
+					const dump_location_t &loc) = 0;
 };
 
 /* A bundle of data for use when attempting to merge two region_model
@@ -2123,11 +2127,11 @@ public:
   {
   }
 
-  void on_unknown_tree_code (path_var pv, const dump_location_t &)
+  void on_unexpected_tree_code (tree t, const dump_location_t &)
     FINAL OVERRIDE
   {
     internal_error ("unhandled tree code: %qs",
-		    get_tree_code_name (TREE_CODE (pv.m_tree)));
+		    get_tree_code_name (TREE_CODE (t)));
   }
 
 private:
diff --git a/gcc/testsuite/gfortran.dg/analyzer/pr93778.f90 b/gcc/testsuite/gfortran.dg/analyzer/pr93778.f90
new file mode 100644
index 00000000000..9112e4980ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/analyzer/pr93778.f90
@@ -0,0 +1,11 @@
+program h0
+  type bl
+     integer jq
+  end type bl
+  type qn
+     type (bl), dimension(3) :: xi
+  end type qn
+  type (qn) ro
+  namelist /i2/ ro
+  read(10, nml = i2)
+end program h0
-- 
2.21.0

