diff --git a/src/pl/plpgsql/src/gram.y b/src/pl/plpgsql/src/gram.y
index e2e3f203ae..c8fc92743c 100644
--- a/src/pl/plpgsql/src/gram.y
+++ b/src/pl/plpgsql/src/gram.y
@@ -9,7 +9,7 @@
  *
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/gram.y,v 1.130 2009/11/05 16:58:36 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/gram.y,v 1.131 2009/11/06 18:37:54 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -520,7 +520,9 @@ decl_aliasitem	: any_identifier
 
 						plpgsql_ns_setlocal(false);
 
-						nsi = plpgsql_ns_lookup(name, NULL, NULL, NULL);
+						nsi = plpgsql_ns_lookup(plpgsql_ns_top(),
+												name, NULL, NULL,
+												NULL);
 						if (nsi == NULL)
 						{
 							plpgsql_error_lineno = plpgsql_scanner_lineno();
@@ -550,7 +552,7 @@ decl_varname	: T_WORD
 					{
 						/*
 						 * Since the scanner is only searching the topmost
-						 * namestack entry, getting T_SCALAR etc can only
+						 * namespace level, getting T_SCALAR etc can only
 						 * happen if the name is already declared in this
 						 * block.
 						 */
@@ -1046,12 +1048,6 @@ for_control		:
 										(errcode(ERRCODE_SYNTAX_ERROR),
 										 errmsg("cursor FOR loop must have only one target variable")));
 
-							/* create loop's private RECORD variable */
-							plpgsql_convert_ident($2.name, &varname, 1);
-							new->rec = plpgsql_build_record(varname,
-															$2.lineno,
-															true);
-
 							/* can't use an unbound cursor this way */
 							if (cursor->cursor_explicit_expr == NULL)
 								ereport(ERROR,
@@ -1063,6 +1059,12 @@ for_control		:
 															 K_LOOP,
 															 "LOOP");
 
+							/* create loop's private RECORD variable */
+							plpgsql_convert_ident($2.name, &varname, 1);
+							new->rec = plpgsql_build_record(varname,
+															$2.lineno,
+															true);
+
 							$$ = (PLpgSQL_stmt *) new;
 						}
 						else
@@ -1157,9 +1159,10 @@ for_control		:
 							else
 							{
 								/*
-								 * No "..", so it must be a query loop. We've prefixed an
-								 * extra SELECT to the query text, so we need to remove that
-								 * before performing syntax checking.
+								 * No "..", so it must be a query loop. We've
+								 * prefixed an extra SELECT to the query text,
+								 * so we need to remove that before performing
+								 * syntax checking.
 								 */
 								char				*tmp_query;
 								PLpgSQL_stmt_fors	*new;
@@ -1700,7 +1703,9 @@ exception_sect	:
 						/*
 						 * We use a mid-rule action to add these
 						 * special variables to the namespace before
-						 * parsing the WHEN clauses themselves.
+						 * parsing the WHEN clauses themselves.  The
+						 * scope of the names extends to the end of the
+						 * current block.
 						 */
 						PLpgSQL_exception_block *new = palloc(sizeof(PLpgSQL_exception_block));
 						PLpgSQL_variable *var;
@@ -1937,8 +1942,6 @@ read_sql_construct(int until,
 	int					lno;
 	StringInfoData		ds;
 	int					parenlevel = 0;
-	Bitmapset		   *paramnos = NULL;
-	char				buf[32];
 	PLpgSQL_expr		*expr;
 
 	lno = plpgsql_scanner_lineno();
@@ -1986,31 +1989,7 @@ read_sql_construct(int until,
 
 		if (plpgsql_SpaceScanned)
 			appendStringInfoChar(&ds, ' ');
-
-		switch (tok)
-		{
-			case T_SCALAR:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.scalar->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.scalar->dno);
-				break;
-
-			case T_ROW:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.row->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.row->dno);
-				break;
-
-			case T_RECORD:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.rec->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.rec->dno);
-				break;
-
-			default:
-				appendStringInfoString(&ds, yytext);
-				break;
-		}
+		appendStringInfoString(&ds, yytext);
 	}
 
 	if (endtoken)
@@ -2020,7 +1999,8 @@ read_sql_construct(int until,
 	expr->dtype			= PLPGSQL_DTYPE_EXPR;
 	expr->query			= pstrdup(ds.data);
 	expr->plan			= NULL;
-	expr->paramnos		= paramnos;
+	expr->paramnos		= NULL;
+	expr->ns            = plpgsql_ns_top();
 	pfree(ds.data);
 
 	if (valid_sql)
@@ -2100,8 +2080,6 @@ static PLpgSQL_stmt *
 make_execsql_stmt(const char *sqlstart, int lineno)
 {
 	StringInfoData		ds;
-	Bitmapset		   *paramnos = NULL;
-	char				buf[32];
 	PLpgSQL_stmt_execsql *execsql;
 	PLpgSQL_expr		*expr;
 	PLpgSQL_row			*row = NULL;
@@ -2147,38 +2125,15 @@ make_execsql_stmt(const char *sqlstart, int lineno)
 
 		if (plpgsql_SpaceScanned)
 			appendStringInfoChar(&ds, ' ');
-
-		switch (tok)
-		{
-			case T_SCALAR:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.scalar->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.scalar->dno);
-				break;
-
-			case T_ROW:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.row->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.row->dno);
-				break;
-
-			case T_RECORD:
-				snprintf(buf, sizeof(buf), " $%d ", yylval.rec->dno + 1);
-				appendStringInfoString(&ds, buf);
-				paramnos = bms_add_member(paramnos, yylval.rec->dno);
-				break;
-
-			default:
-				appendStringInfoString(&ds, yytext);
-				break;
-		}
+		appendStringInfoString(&ds, yytext);
 	}
 
 	expr = palloc0(sizeof(PLpgSQL_expr));
 	expr->dtype			= PLPGSQL_DTYPE_EXPR;
 	expr->query			= pstrdup(ds.data);
 	expr->plan			= NULL;
-	expr->paramnos		= paramnos;
+	expr->paramnos		= NULL;
+	expr->ns            = plpgsql_ns_top();
 	pfree(ds.data);
 
 	check_sql_expr(expr->query);
@@ -2804,7 +2759,7 @@ check_label(const char *yytxt)
 	char	   *label_name;
 
 	plpgsql_convert_ident(yytxt, &label_name, 1);
-	if (plpgsql_ns_lookup_label(label_name) == NULL)
+	if (plpgsql_ns_lookup_label(plpgsql_ns_top(), label_name) == NULL)
 		yyerror("label does not exist");
 	return label_name;
 }
@@ -3005,20 +2960,23 @@ make_case(int lineno, PLpgSQL_expr *t_expr,
 	 */
 	if (t_expr)
 	{
-		ListCell *l;
+		char	varname[32];
 		PLpgSQL_var *t_var;
-		int		t_varno;
+		ListCell *l;
+
+		/* use a name unlikely to collide with any user names */
+		snprintf(varname, sizeof(varname), "__Case__Variable_%d__",
+				 plpgsql_nDatums);
 
 		/*
 		 * We don't yet know the result datatype of t_expr.  Build the
 		 * variable as if it were INT4; we'll fix this at runtime if needed.
 		 */
 		t_var = (PLpgSQL_var *)
-			plpgsql_build_variable("*case*", lineno,
+			plpgsql_build_variable(varname, lineno,
 								   plpgsql_build_datatype(INT4OID, -1),
-								   false);
-		t_varno = t_var->dno;
-		new->t_varno = t_varno;
+								   true);
+		new->t_varno = t_var->dno;
 
 		foreach(l, case_when_list)
 		{
@@ -3026,21 +2984,19 @@ make_case(int lineno, PLpgSQL_expr *t_expr,
 			PLpgSQL_expr *expr = cwt->expr;
 			StringInfoData	ds;
 
-			/* Must add the CASE variable as an extra param to expression */
-			expr->paramnos = bms_add_member(expr->paramnos, t_varno);
-
 			/* copy expression query without SELECT keyword (expr->query + 7) */
 			Assert(strncmp(expr->query, "SELECT ", 7) == 0);
 
 			/* And do the string hacking */
 			initStringInfo(&ds);
 
-			appendStringInfo(&ds, "SELECT $%d IN (%s)",
-							 t_varno + 1,
-							 expr->query + 7);
+			appendStringInfo(&ds, "SELECT \"%s\" IN (%s)",
+							 varname, expr->query + 7);
 
 			pfree(expr->query);
 			expr->query = pstrdup(ds.data);
+			/* Adjust expr's namespace to include the case variable */
+			expr->ns = plpgsql_ns_top();
 
 			pfree(ds.data);
 		}
diff --git a/src/pl/plpgsql/src/pl_comp.c b/src/pl/plpgsql/src/pl_comp.c
index ef0dcb0f8d..be1d90a2f2 100644
--- a/src/pl/plpgsql/src/pl_comp.c
+++ b/src/pl/plpgsql/src/pl_comp.c
@@ -8,7 +8,7 @@
  *
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_comp.c,v 1.140 2009/11/04 22:26:07 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_comp.c,v 1.141 2009/11/06 18:37:54 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -96,6 +96,11 @@ static PLpgSQL_function *do_compile(FunctionCallInfo fcinfo,
 		   PLpgSQL_func_hashkey *hashkey,
 		   bool forValidator);
 static void add_dummy_return(PLpgSQL_function *function);
+static Node *plpgsql_pre_column_ref(ParseState *pstate, ColumnRef *cref);
+static Node *plpgsql_post_column_ref(ParseState *pstate, ColumnRef *cref, Node *var);
+static Node *plpgsql_param_ref(ParseState *pstate, ParamRef *pref);
+static Node *resolve_column_ref(PLpgSQL_expr *expr, ColumnRef *cref);
+static Node *make_datum_param(PLpgSQL_expr *expr, int dno, int location);
 static PLpgSQL_row *build_row_from_class(Oid classOid);
 static PLpgSQL_row *build_row_from_vars(PLpgSQL_variable **vars, int numvars);
 static PLpgSQL_type *build_datatype(HeapTuple typeTup, int32 typmod);
@@ -306,21 +311,6 @@ do_compile(FunctionCallInfo fcinfo,
 	plerrcontext.previous = error_context_stack;
 	error_context_stack = &plerrcontext;
 
-	/*
-	 * Initialize the compiler, particularly the namespace stack.  The
-	 * outermost namespace contains function parameters and other special
-	 * variables (such as FOUND), and is named after the function itself.
-	 */
-	plpgsql_ns_init();
-	plpgsql_ns_push(NameStr(procStruct->proname));
-	plpgsql_DumpExecTree = false;
-
-	datums_alloc = 128;
-	plpgsql_nDatums = 0;
-	/* This is short-lived, so needn't allocate in function's cxt */
-	plpgsql_Datums = palloc(sizeof(PLpgSQL_datum *) * datums_alloc);
-	datums_last = 0;
-
 	/*
 	 * Do extra syntax checks when validating the function definition. We skip
 	 * this when actually compiling functions for execution, for performance
@@ -345,8 +335,8 @@ do_compile(FunctionCallInfo fcinfo,
 	plpgsql_curr_compile = function;
 
 	/*
-	 * All the rest of the compile-time storage (e.g. parse tree) is kept in
-	 * its own memory context, so it can be reclaimed easily.
+	 * All the permanent output of compilation (e.g. parse tree) is kept in
+	 * a per-function memory context, so it can be reclaimed easily.
 	 */
 	func_cxt = AllocSetContextCreate(TopMemoryContext,
 									 "PL/PgSQL function context",
@@ -362,6 +352,23 @@ do_compile(FunctionCallInfo fcinfo,
 	function->fn_is_trigger = is_trigger;
 	function->fn_cxt = func_cxt;
 	function->out_param_varno = -1;		/* set up for no OUT param */
+	function->resolve_option = PLPGSQL_RESOLVE_BEFORE;
+
+	/*
+	 * Initialize the compiler, particularly the namespace stack.  The
+	 * outermost namespace contains function parameters and other special
+	 * variables (such as FOUND), and is named after the function itself.
+	 */
+	plpgsql_ns_init();
+	plpgsql_ns_push(NameStr(procStruct->proname));
+	plpgsql_DumpExecTree = false;
+
+	datums_alloc = 128;
+	plpgsql_nDatums = 0;
+	/* This is short-lived, so needn't allocate in function's cxt */
+	plpgsql_Datums = MemoryContextAlloc(compile_tmp_cxt,
+										sizeof(PLpgSQL_datum *) * datums_alloc);
+	datums_last = 0;
 
 	switch (is_trigger)
 	{
@@ -755,15 +762,6 @@ plpgsql_compile_inline(char *proc_source)
 	plerrcontext.previous = error_context_stack;
 	error_context_stack = &plerrcontext;
 
-	plpgsql_ns_init();
-	plpgsql_ns_push(func_name);
-	plpgsql_DumpExecTree = false;
-
-	datums_alloc = 128;
-	plpgsql_nDatums = 0;
-	plpgsql_Datums = palloc(sizeof(PLpgSQL_datum *) * datums_alloc);
-	datums_last = 0;
-
 	/* Do extra syntax checking if check_function_bodies is on */
 	plpgsql_check_syntax = check_function_bodies;
 
@@ -787,6 +785,16 @@ plpgsql_compile_inline(char *proc_source)
 	function->fn_is_trigger = false;
 	function->fn_cxt = func_cxt;
 	function->out_param_varno = -1;		/* set up for no OUT param */
+	function->resolve_option = PLPGSQL_RESOLVE_BEFORE;
+
+	plpgsql_ns_init();
+	plpgsql_ns_push(func_name);
+	plpgsql_DumpExecTree = false;
+
+	datums_alloc = 128;
+	plpgsql_nDatums = 0;
+	plpgsql_Datums = palloc(sizeof(PLpgSQL_datum *) * datums_alloc);
+	datums_last = 0;
 
 	/* Set up as though in a function returning VOID */
 	function->fn_rettype = VOIDOID;
@@ -920,6 +928,319 @@ add_dummy_return(PLpgSQL_function *function)
 }
 
 
+/*
+ * plpgsql_parser_setup		set up parser hooks for dynamic parameters
+ *
+ * Note: this routine, and the hook functions it prepares for, are logically
+ * part of plpgsql parsing.  But they actually run during function execution,
+ * when we are ready to evaluate a SQL query or expression that has not
+ * previously been parsed and planned.
+ */
+void
+plpgsql_parser_setup(struct ParseState *pstate, PLpgSQL_expr *expr)
+{
+	pstate->p_pre_columnref_hook = plpgsql_pre_column_ref;
+	pstate->p_post_columnref_hook = plpgsql_post_column_ref;
+	pstate->p_paramref_hook = plpgsql_param_ref;
+	/* no need to use p_coerce_param_hook */
+	pstate->p_ref_hook_state = (void *) expr;
+}
+
+/*
+ * plpgsql_pre_column_ref		parser callback before parsing a ColumnRef
+ */
+static Node *
+plpgsql_pre_column_ref(ParseState *pstate, ColumnRef *cref)
+{
+	PLpgSQL_expr *expr = (PLpgSQL_expr *) pstate->p_ref_hook_state;
+
+	if (expr->func->resolve_option == PLPGSQL_RESOLVE_BEFORE)
+		return resolve_column_ref(expr, cref);
+	else
+		return NULL;
+}
+
+/*
+ * plpgsql_post_column_ref		parser callback after parsing a ColumnRef
+ */
+static Node *
+plpgsql_post_column_ref(ParseState *pstate, ColumnRef *cref, Node *var)
+{
+	PLpgSQL_expr *expr = (PLpgSQL_expr *) pstate->p_ref_hook_state;
+	Node	   *myvar;
+
+	if (expr->func->resolve_option == PLPGSQL_RESOLVE_BEFORE)
+		return NULL;			/* we already found there's no match */
+
+	if (expr->func->resolve_option == PLPGSQL_RESOLVE_AFTER && var != NULL)
+		return NULL;			/* there's a table column, prefer that */
+
+	myvar = resolve_column_ref(expr, cref);
+
+	if (myvar != NULL && var != NULL)
+	{
+		/*
+		 * We could leave it to the core parser to throw this error, but
+		 * we can add a more useful detail message than the core could.
+		 */
+		ereport(ERROR,
+				(errcode(ERRCODE_AMBIGUOUS_COLUMN),
+				 errmsg("column reference \"%s\" is ambiguous",
+						NameListToString(cref->fields)),
+				 errdetail("It could refer to either a PL/pgSQL variable or a table column."),
+				 parser_errposition(pstate, cref->location)));
+	}
+
+	return myvar;
+}
+
+/*
+ * plpgsql_param_ref		parser callback for ParamRefs ($n symbols)
+ */
+static Node *
+plpgsql_param_ref(ParseState *pstate, ParamRef *pref)
+{
+	PLpgSQL_expr *expr = (PLpgSQL_expr *) pstate->p_ref_hook_state;
+	char		pname[32];
+	PLpgSQL_nsitem *nse;
+
+	snprintf(pname, sizeof(pname), "$%d", pref->number);
+
+	nse = plpgsql_ns_lookup(expr->ns,
+							pname, NULL, NULL,
+							NULL);
+
+	if (nse == NULL)
+		return NULL;			/* name not known to plpgsql */
+
+	return make_datum_param(expr, nse->itemno, pref->location);
+}
+
+/*
+ * resolve_column_ref		attempt to resolve a ColumnRef as a plpgsql var
+ *
+ * Returns the translated node structure, or NULL if name not found
+ */
+static Node *
+resolve_column_ref(PLpgSQL_expr *expr, ColumnRef *cref)
+{
+	PLpgSQL_execstate *estate;
+	PLpgSQL_nsitem *nse;
+	const char *name1;
+	const char *name2 = NULL;
+	const char *name3 = NULL;
+	const char *colname = NULL;
+	int			nnames;
+	int			nnames_scalar = 0;
+	int			nnames_wholerow = 0;
+	int			nnames_field = 0;
+
+	/*
+	 * We use the function's current estate to resolve parameter data types.
+	 * This is really pretty bogus because there is no provision for updating
+	 * plans when those types change ...
+	 */
+	estate = expr->func->cur_estate;
+
+	/*----------
+	 * The allowed syntaxes are:
+	 *
+	 * A		Scalar variable reference, or whole-row record reference.
+	 * A.B		Qualified scalar or whole-row reference, or field reference.
+	 * A.B.C	Qualified record field reference.
+	 * A.*		Whole-row record reference.
+	 * A.B.*	Qualified whole-row record reference.
+	 *----------
+	 */
+	switch (list_length(cref->fields))
+	{
+		case 1:
+			{
+				Node	   *field1 = (Node *) linitial(cref->fields);
+
+				Assert(IsA(field1, String));
+				name1 = strVal(field1);
+				nnames_scalar = 1;
+				nnames_wholerow = 1;
+				break;
+			}
+		case 2:
+			{
+				Node	   *field1 = (Node *) linitial(cref->fields);
+				Node	   *field2 = (Node *) lsecond(cref->fields);
+
+				Assert(IsA(field1, String));
+				name1 = strVal(field1);
+
+				/* Whole-row reference? */
+				if (IsA(field2, A_Star))
+				{
+					/* Set name2 to prevent matches to scalar variables */
+					name2 = "*";
+					nnames_wholerow = 1;
+					break;
+				}
+
+				Assert(IsA(field2, String));
+				name2 = strVal(field2);
+				colname = name2;
+				nnames_scalar = 2;
+				nnames_wholerow = 2;
+				nnames_field = 1;
+				break;
+			}
+		case 3:
+			{
+				Node	   *field1 = (Node *) linitial(cref->fields);
+				Node	   *field2 = (Node *) lsecond(cref->fields);
+				Node	   *field3 = (Node *) lthird(cref->fields);
+
+				Assert(IsA(field1, String));
+				name1 = strVal(field1);
+				Assert(IsA(field2, String));
+				name2 = strVal(field2);
+
+				/* Whole-row reference? */
+				if (IsA(field3, A_Star))
+				{
+					/* Set name3 to prevent matches to scalar variables */
+					name3 = "*";
+					nnames_wholerow = 2;
+					break;
+				}
+
+				Assert(IsA(field3, String));
+				name3 = strVal(field3);
+				colname = name3;
+				nnames_field = 2;
+				break;
+			}
+		default:
+			/* too many names, ignore */
+			return NULL;
+	}
+
+	nse = plpgsql_ns_lookup(expr->ns,
+							name1, name2, name3,
+							&nnames);
+
+	if (nse == NULL)
+		return NULL;			/* name not known to plpgsql */
+
+	switch (nse->itemtype)
+	{
+		case PLPGSQL_NSTYPE_VAR:
+			if (nnames == nnames_scalar)
+				return make_datum_param(expr, nse->itemno, cref->location);
+			break;
+		case PLPGSQL_NSTYPE_REC:
+			if (nnames == nnames_wholerow)
+				return make_datum_param(expr, nse->itemno, cref->location);
+			if (nnames == nnames_field)
+			{
+				/* colname must be a field in this record */
+				PLpgSQL_rec *rec = (PLpgSQL_rec *) estate->datums[nse->itemno];
+				FieldSelect *fselect;
+				Oid			fldtype;
+				int			fldno;
+				int			i;
+
+				/* search for a datum referencing this field */
+				for (i = 0; i < estate->ndatums; i++)
+				{
+					PLpgSQL_recfield *fld = (PLpgSQL_recfield *) estate->datums[i];
+
+					if (fld->dtype == PLPGSQL_DTYPE_RECFIELD &&
+						fld->recparentno == nse->itemno &&
+						strcmp(fld->fieldname, colname) == 0)
+					{
+						return make_datum_param(expr, i, cref->location);
+					}
+				}
+
+				/*
+				 * We can't readily add a recfield datum at runtime, so
+				 * instead build a whole-row Param and a FieldSelect node.
+				 * This is a bit less efficient, so we prefer the recfield
+				 * way when possible.
+				 */
+				fldtype = exec_get_rec_fieldtype(rec, colname,
+												 &fldno);
+				fselect = makeNode(FieldSelect);
+				fselect->arg = (Expr *) make_datum_param(expr, nse->itemno,
+														 cref->location);
+				fselect->fieldnum = fldno;
+				fselect->resulttype = fldtype;
+				fselect->resulttypmod = -1;
+				return (Node *) fselect;
+			}
+			break;
+		case PLPGSQL_NSTYPE_ROW:
+			if (nnames == nnames_wholerow)
+				return make_datum_param(expr, nse->itemno, cref->location);
+			if (nnames == nnames_field)
+			{
+				/* colname must be a field in this row */
+				PLpgSQL_row *row = (PLpgSQL_row *) estate->datums[nse->itemno];
+				int			i;
+
+				for (i = 0; i < row->nfields; i++)
+				{
+					if (row->fieldnames[i] &&
+						strcmp(row->fieldnames[i], colname) == 0)
+					{
+						return make_datum_param(expr, row->varnos[i],
+												cref->location);
+					}
+				}
+				ereport(ERROR,
+						(errcode(ERRCODE_UNDEFINED_COLUMN),
+						 errmsg("row \"%s\" has no field \"%s\"",
+								row->refname, colname)));
+			}
+			break;
+		default:
+			elog(ERROR, "unrecognized plpgsql itemtype");
+	}
+
+	/* Name format doesn't match the plpgsql variable type */
+	return NULL;
+}
+
+/*
+ * Helper for columnref parsing: build a Param referencing a plpgsql datum,
+ * and make sure that that datum is listed in the expression's paramnos.
+ */
+static Node *
+make_datum_param(PLpgSQL_expr *expr, int dno, int location)
+{
+	PLpgSQL_execstate *estate;
+	Param	   *param;
+	MemoryContext oldcontext;
+
+	/* see comment in resolve_column_ref */
+	estate = expr->func->cur_estate;
+
+	Assert(dno >= 0 && dno < estate->ndatums);
+
+	/*
+	 * Bitmapset must be allocated in function's permanent memory context
+	 */
+	oldcontext = MemoryContextSwitchTo(expr->func->fn_cxt);
+	expr->paramnos = bms_add_member(expr->paramnos, dno);
+	MemoryContextSwitchTo(oldcontext);
+
+	param = makeNode(Param);
+	param->paramkind = PARAM_EXTERN;
+	param->paramid = dno + 1;
+	param->paramtype = exec_get_datum_type(estate, estate->datums[dno]);
+	param->paramtypmod = -1;
+	param->location = location;
+
+	return (Node *) param;
+}
+
+
 /* ----------
  * plpgsql_parse_word		The scanner calls this to postparse
  *				any single word not found by a
@@ -936,9 +1257,11 @@ plpgsql_parse_word(const char *word)
 	plpgsql_convert_ident(word, cp, 1);
 
 	/*
-	 * Do a lookup on the compiler's namestack
+	 * Do a lookup in the current namespace stack
 	 */
-	nse = plpgsql_ns_lookup(cp[0], NULL, NULL, NULL);
+	nse = plpgsql_ns_lookup(plpgsql_ns_top(),
+							cp[0], NULL, NULL,
+							NULL);
 	pfree(cp[0]);
 
 	if (nse != NULL)
@@ -986,9 +1309,11 @@ plpgsql_parse_dblword(const char *word)
 	plpgsql_convert_ident(word, cp, 2);
 
 	/*
-	 * Do a lookup on the compiler's namestack
+	 * Do a lookup in the current namespace stack
 	 */
-	ns = plpgsql_ns_lookup(cp[0], cp[1], NULL, &nnames);
+	ns = plpgsql_ns_lookup(plpgsql_ns_top(),
+						   cp[0], cp[1], NULL,
+						   &nnames);
 	if (ns == NULL)
 	{
 		pfree(cp[0]);
@@ -1098,10 +1423,12 @@ plpgsql_parse_tripword(const char *word)
 	plpgsql_convert_ident(word, cp, 3);
 
 	/*
-	 * Do a lookup on the compiler's namestack. Must find a qualified
+	 * Do a lookup in the current namespace stack. Must find a qualified
 	 * reference.
 	 */
-	ns = plpgsql_ns_lookup(cp[0], cp[1], cp[2], &nnames);
+	ns = plpgsql_ns_lookup(plpgsql_ns_top(),
+						   cp[0], cp[1], cp[2],
+						   &nnames);
 	if (ns == NULL || nnames != 2)
 	{
 		pfree(cp[0]);
@@ -1201,10 +1528,12 @@ plpgsql_parse_wordtype(char *word)
 	pfree(cp[1]);
 
 	/*
-	 * Do a lookup on the compiler's namestack.  Ensure we scan all levels.
+	 * Do a lookup in the current namespace stack.  Ensure we scan all levels.
 	 */
 	old_nsstate = plpgsql_ns_setlocal(false);
-	nse = plpgsql_ns_lookup(cp[0], NULL, NULL, NULL);
+	nse = plpgsql_ns_lookup(plpgsql_ns_top(),
+							cp[0], NULL, NULL,
+							NULL);
 	plpgsql_ns_setlocal(old_nsstate);
 
 	if (nse != NULL)
@@ -1224,8 +1553,8 @@ plpgsql_parse_wordtype(char *word)
 	}
 
 	/*
-	 * Word wasn't found on the namestack. Try to find a data type with that
-	 * name, but ignore shell types and complex types.
+	 * Word wasn't found in the namespace stack. Try to find a data type
+	 * with that name, but ignore shell types and complex types.
 	 */
 	typeTup = LookupTypeName(NULL, makeTypeName(cp[0]), NULL);
 	if (typeTup)
@@ -1289,12 +1618,14 @@ plpgsql_parse_dblwordtype(char *word)
 	pfree(cp[2]);
 
 	/*
-	 * Do a lookup on the compiler's namestack.  Ensure we scan all levels. We
-	 * don't need to check number of names matched, because we will only
+	 * Do a lookup in the current namespace stack.  Ensure we scan all levels.
+	 * We don't need to check number of names matched, because we will only
 	 * consider scalar variables.
 	 */
 	old_nsstate = plpgsql_ns_setlocal(false);
-	nse = plpgsql_ns_lookup(cp[0], cp[1], NULL, NULL);
+	nse = plpgsql_ns_lookup(plpgsql_ns_top(),
+							cp[0], cp[1], NULL,
+							NULL);
 	plpgsql_ns_setlocal(old_nsstate);
 
 	if (nse != NULL && nse->itemtype == PLPGSQL_NSTYPE_VAR)
diff --git a/src/pl/plpgsql/src/pl_exec.c b/src/pl/plpgsql/src/pl_exec.c
index f792020638..0c0f077845 100644
--- a/src/pl/plpgsql/src/pl_exec.c
+++ b/src/pl/plpgsql/src/pl_exec.c
@@ -8,7 +8,7 @@
  *
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_exec.c,v 1.249 2009/11/04 22:26:07 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_exec.c,v 1.250 2009/11/06 18:37:54 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -26,7 +26,6 @@
 #include "lib/stringinfo.h"
 #include "miscadmin.h"
 #include "nodes/nodeFuncs.h"
-#include "parser/parse_node.h"
 #include "parser/scansup.h"
 #include "storage/proc.h"
 #include "tcop/tcopprot.h"
@@ -158,8 +157,6 @@ static void exec_eval_datum(PLpgSQL_execstate *estate,
 				Oid *typeid,
 				Datum *value,
 				bool *isnull);
-static Oid exec_get_datum_type(PLpgSQL_execstate *estate,
-							   PLpgSQL_datum *datum);
 static int exec_eval_integer(PLpgSQL_execstate *estate,
 				  PLpgSQL_expr *expr,
 				  bool *isNull);
@@ -176,8 +173,6 @@ static int exec_for_query(PLpgSQL_execstate *estate, PLpgSQL_stmt_forq *stmt,
 			   Portal portal, bool prefetch_ok);
 static ParamListInfo setup_param_list(PLpgSQL_execstate *estate,
 									  PLpgSQL_expr *expr);
-static void plpgsql_parser_setup(ParseState *pstate, PLpgSQL_expr *expr);
-static Node *plpgsql_param_ref(ParseState *pstate, ParamRef *pref);
 static void plpgsql_param_fetch(ParamListInfo params, int paramid);
 static void exec_move_row(PLpgSQL_execstate *estate,
 			  PLpgSQL_rec *rec,
@@ -3992,7 +3987,7 @@ exec_eval_datum(PLpgSQL_execstate *estate,
  * a tupdesc but no row value for a record variable.  (This currently can
  * happen only for a trigger's NEW/OLD records.)
  */
-static Oid
+Oid
 exec_get_datum_type(PLpgSQL_execstate *estate,
 					PLpgSQL_datum *datum)
 {
@@ -4068,6 +4063,36 @@ exec_get_datum_type(PLpgSQL_execstate *estate,
 	return typeid;
 }
 
+/*
+ * exec_get_rec_fieldtype				Get datatype of a PLpgSQL record field
+ *
+ * Also returns the field number to *fieldno.
+ */
+Oid
+exec_get_rec_fieldtype(PLpgSQL_rec *rec, const char *fieldname,
+					   int *fieldno)
+{
+	Oid			typeid;
+	int			fno;
+
+	if (rec->tupdesc == NULL)
+		ereport(ERROR,
+				(errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
+				 errmsg("record \"%s\" is not assigned yet",
+						rec->refname),
+				 errdetail("The tuple structure of a not-yet-assigned record is indeterminate.")));
+	fno = SPI_fnumber(rec->tupdesc, fieldname);
+	if (fno == SPI_ERROR_NOATTRIBUTE)
+		ereport(ERROR,
+				(errcode(ERRCODE_UNDEFINED_COLUMN),
+				 errmsg("record \"%s\" has no field \"%s\"",
+						rec->refname, fieldname)));
+	typeid = SPI_gettypeid(rec->tupdesc, fno);
+
+	*fieldno = fno;
+	return typeid;
+}
+
 /* ----------
  * exec_eval_integer		Evaluate an expression, coerce result to int4
  *
@@ -4590,51 +4615,6 @@ setup_param_list(PLpgSQL_execstate *estate, PLpgSQL_expr *expr)
 	return paramLI;
 }
 
-/*
- * plpgsql_parser_setup		set up parser hooks for dynamic parameters
- */
-static void
-plpgsql_parser_setup(ParseState *pstate, PLpgSQL_expr *expr)
-{
-	pstate->p_ref_hook_state = (void *) expr;
-	pstate->p_paramref_hook = plpgsql_param_ref;
-	/* no need to use p_coerce_param_hook */
-}
-
-/*
- * plpgsql_param_ref		parser callback for ParamRefs ($n symbols)
- */
-static Node *
-plpgsql_param_ref(ParseState *pstate, ParamRef *pref)
-{
-	int			paramno = pref->number;
-	PLpgSQL_expr *expr = (PLpgSQL_expr *) pstate->p_ref_hook_state;
-	PLpgSQL_execstate *estate;
-	Param	   *param;
-
-	/* Let's just check parameter number is in range */
-	if (!bms_is_member(paramno-1, expr->paramnos))
-		return NULL;
-
-	/*
-	 * We use the function's current estate to resolve parameter data types.
-	 * This is really pretty bogus because there is no provision for updating
-	 * plans when those types change ...
-	 */
-	estate = expr->func->cur_estate;
-	Assert(paramno <= estate->ndatums);
-
-	param = makeNode(Param);
-	param->paramkind = PARAM_EXTERN;
-	param->paramid = paramno;
-	param->paramtype = exec_get_datum_type(estate,
-										   estate->datums[paramno-1]);
-	param->paramtypmod = -1;
-	param->location = pref->location;
-
-	return (Node *) param;
-}
-
 /*
  * plpgsql_param_fetch		paramFetch callback for dynamic parameter fetch
  */
diff --git a/src/pl/plpgsql/src/pl_funcs.c b/src/pl/plpgsql/src/pl_funcs.c
index 790e2e86ba..84a7633afd 100644
--- a/src/pl/plpgsql/src/pl_funcs.c
+++ b/src/pl/plpgsql/src/pl_funcs.c
@@ -8,7 +8,7 @@
  *
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_funcs.c,v 1.83 2009/11/05 16:58:36 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/pl_funcs.c,v 1.84 2009/11/06 18:37:54 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -21,21 +21,31 @@
 
 
 /* ----------
- * Local variables for the namestack handling
+ * Local variables for namespace handling
+ *
+ * The namespace structure actually forms a tree, of which only one linear
+ * list or "chain" (from the youngest item to the root) is accessible from
+ * any one plpgsql statement.  During initial parsing of a function, ns_top
+ * points to the youngest item accessible from the block currently being
+ * parsed.  We store the entire tree, however, since at runtime we will need
+ * to access the chain that's relevant to any one statement.
+ *
+ * Block boundaries in the namespace chain are marked by PLPGSQL_NSTYPE_LABEL
+ * items.
  * ----------
  */
-static PLpgSQL_ns *ns_current = NULL;
+static PLpgSQL_nsitem *ns_top = NULL;
 static bool ns_localmode = false;
 
 
 /* ----------
- * plpgsql_ns_init			Initialize the namestack
+ * plpgsql_ns_init			Initialize namespace processing for a new function
  * ----------
  */
 void
 plpgsql_ns_init(void)
 {
-	ns_current = NULL;
+	ns_top = NULL;
 	ns_localmode = false;
 }
 
@@ -49,7 +59,9 @@ plpgsql_ns_init(void)
  * examining a name being declared in a DECLARE section.  For that case
  * we only want to know if there is a conflicting name earlier in the
  * same DECLARE section.  So the grammar must temporarily set local mode
- * before scanning decl_varnames.
+ * before scanning decl_varnames.  This should eventually go away in favor
+ * of a localmode argument to plpgsql_ns_lookup, or perhaps some less
+ * indirect method of dealing with duplicate namespace entries.
  * ----------
  */
 bool
@@ -64,83 +76,67 @@ plpgsql_ns_setlocal(bool flag)
 
 
 /* ----------
- * plpgsql_ns_push			Enter a new namestack level
+ * plpgsql_ns_push			Create a new namespace level
  * ----------
  */
 void
 plpgsql_ns_push(const char *label)
 {
-	PLpgSQL_ns *new;
-
 	if (label == NULL)
 		label = "";
-
-	new = palloc0(sizeof(PLpgSQL_ns));
-	new->upper = ns_current;
-	ns_current = new;
-
 	plpgsql_ns_additem(PLPGSQL_NSTYPE_LABEL, 0, label);
 }
 
 
 /* ----------
- * plpgsql_ns_pop			Return to the previous level
+ * plpgsql_ns_pop			Pop entries back to (and including) the last label
  * ----------
  */
 void
 plpgsql_ns_pop(void)
 {
-	int			i;
-	PLpgSQL_ns *old;
-
-	old = ns_current;
-	ns_current = old->upper;
-
-	for (i = 0; i < old->items_used; i++)
-		pfree(old->items[i]);
-	pfree(old->items);
-	pfree(old);
+	Assert(ns_top != NULL);
+	while (ns_top->itemtype != PLPGSQL_NSTYPE_LABEL)
+		ns_top = ns_top->prev;
+	ns_top = ns_top->prev;
 }
 
 
 /* ----------
- * plpgsql_ns_additem			Add an item to the current
- *					namestack level
+ * plpgsql_ns_top			Fetch the current namespace chain end
+ * ----------
+ */
+PLpgSQL_nsitem *
+plpgsql_ns_top(void)
+{
+	return ns_top;
+}
+
+
+/* ----------
+ * plpgsql_ns_additem		Add an item to the current namespace chain
  * ----------
  */
 void
 plpgsql_ns_additem(int itemtype, int itemno, const char *name)
 {
-	PLpgSQL_ns *ns = ns_current;
 	PLpgSQL_nsitem *nse;
 
 	Assert(name != NULL);
-
-	if (ns->items_used == ns->items_alloc)
-	{
-		if (ns->items_alloc == 0)
-		{
-			ns->items_alloc = 32;
-			ns->items = palloc(sizeof(PLpgSQL_nsitem *) * ns->items_alloc);
-		}
-		else
-		{
-			ns->items_alloc *= 2;
-			ns->items = repalloc(ns->items,
-								 sizeof(PLpgSQL_nsitem *) * ns->items_alloc);
-		}
-	}
+	/* first item added must be a label */
+	Assert(ns_top != NULL || itemtype == PLPGSQL_NSTYPE_LABEL);
 
 	nse = palloc(sizeof(PLpgSQL_nsitem) + strlen(name));
 	nse->itemtype = itemtype;
 	nse->itemno = itemno;
+	nse->prev = ns_top;
 	strcpy(nse->name, name);
-	ns->items[ns->items_used++] = nse;
+	ns_top = nse;
 }
 
 
 /* ----------
- * plpgsql_ns_lookup			Lookup an identifier in the namestack
+ * plpgsql_ns_lookup		Lookup an identifier in the given namespace chain
  *
  * Note that this only searches for variables, not labels.
  *
@@ -158,20 +154,20 @@ plpgsql_ns_additem(int itemtype, int itemno, const char *name)
  * ----------
  */
 PLpgSQL_nsitem *
-plpgsql_ns_lookup(const char *name1, const char *name2, const char *name3,
+plpgsql_ns_lookup(PLpgSQL_nsitem *ns_cur,
+				  const char *name1, const char *name2, const char *name3,
 				  int *names_used)
 {
-	PLpgSQL_ns *ns;
-	int			i;
-
-	/* Scan each level of the namestack */
-	for (ns = ns_current; ns != NULL; ns = ns->upper)
+	/* Outer loop iterates once per block level in the namespace chain */
+	while (ns_cur != NULL)
 	{
-		/* Check for unqualified match to variable name */
-		for (i = 1; i < ns->items_used; i++)
-		{
-			PLpgSQL_nsitem *nsitem = ns->items[i];
+		PLpgSQL_nsitem *nsitem;
 
+		/* Check this level for unqualified match to variable name */
+		for (nsitem = ns_cur;
+			 nsitem->itemtype != PLPGSQL_NSTYPE_LABEL;
+			 nsitem = nsitem->prev)
+		{
 			if (strcmp(nsitem->name, name1) == 0)
 			{
 				if (name2 == NULL ||
@@ -184,14 +180,14 @@ plpgsql_ns_lookup(const char *name1, const char *name2, const char *name3,
 			}
 		}
 
-		/* Check for qualified match to variable name */
+		/* Check this level for qualified match to variable name */
 		if (name2 != NULL &&
-			strcmp(ns->items[0]->name, name1) == 0)
+			strcmp(nsitem->name, name1) == 0)
 		{
-			for (i = 1; i < ns->items_used; i++)
+			for (nsitem = ns_cur;
+				 nsitem->itemtype != PLPGSQL_NSTYPE_LABEL;
+				 nsitem = nsitem->prev)
 			{
-				PLpgSQL_nsitem *nsitem = ns->items[i];
-
 				if (strcmp(nsitem->name, name2) == 0)
 				{
 					if (name3 == NULL ||
@@ -207,6 +203,8 @@ plpgsql_ns_lookup(const char *name1, const char *name2, const char *name3,
 
 		if (ns_localmode)
 			break;				/* do not look into upper levels */
+
+		ns_cur = nsitem->prev;
 	}
 
 	/* This is just to suppress possibly-uninitialized-variable warnings */
@@ -217,18 +215,18 @@ plpgsql_ns_lookup(const char *name1, const char *name2, const char *name3,
 
 
 /* ----------
- * plpgsql_ns_lookup_label		Lookup a label in the namestack
+ * plpgsql_ns_lookup_label		Lookup a label in the given namespace chain
  * ----------
  */
 PLpgSQL_nsitem *
-plpgsql_ns_lookup_label(const char *name)
+plpgsql_ns_lookup_label(PLpgSQL_nsitem *ns_cur, const char *name)
 {
-	PLpgSQL_ns *ns;
-
-	for (ns = ns_current; ns != NULL; ns = ns->upper)
+	while (ns_cur != NULL)
 	{
-		if (strcmp(ns->items[0]->name, name) == 0)
-			return ns->items[0];
+		if (ns_cur->itemtype == PLPGSQL_NSTYPE_LABEL &&
+			strcmp(ns_cur->name, name) == 0)
+			return ns_cur;
+		ns_cur = ns_cur->prev;
 	}
 
 	return NULL;				/* label not found */
diff --git a/src/pl/plpgsql/src/plpgsql.h b/src/pl/plpgsql/src/plpgsql.h
index 193d8d5c4c..a34748475e 100644
--- a/src/pl/plpgsql/src/plpgsql.h
+++ b/src/pl/plpgsql/src/plpgsql.h
@@ -8,7 +8,7 @@
  *
  *
  * IDENTIFICATION
- *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/plpgsql.h,v 1.119 2009/11/05 16:58:36 tgl Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plpgsql/src/plpgsql.h,v 1.120 2009/11/06 18:37:54 tgl Exp $
  *
  *-------------------------------------------------------------------------
  */
@@ -37,7 +37,7 @@
 #define _(x) dgettext(TEXTDOMAIN, x)
 
 /* ----------
- * Compiler's namestack item types
+ * Compiler's namespace item types
  * ----------
  */
 enum
@@ -140,6 +140,17 @@ enum
 	PLPGSQL_RAISEOPTION_HINT
 };
 
+/* --------
+ * Behavioral modes for plpgsql variable resolution
+ * --------
+ */
+typedef enum
+{
+	PLPGSQL_RESOLVE_BEFORE,		/* prefer plpgsql var to table column */
+	PLPGSQL_RESOLVE_AFTER,		/* prefer table column to plpgsql var */
+	PLPGSQL_RESOLVE_ERROR		/* throw error if ambiguous */
+} PLpgSQL_resolve_option;
+
 
 /**********************************************************************
  * Node and structure definitions
@@ -193,6 +204,9 @@ typedef struct PLpgSQL_expr
 	/* function containing this expr (not set until we first parse query) */
 	struct PLpgSQL_function *func;
 
+	/* namespace chain visible to this expr */
+	struct PLpgSQL_nsitem *ns;
+
 	/* fields for "simple expression" fast-path execution: */
 	Expr	   *expr_simple_expr;		/* NULL means not a simple expr */
 	int			expr_simple_generation; /* plancache generation we checked */
@@ -283,24 +297,15 @@ typedef struct
 } PLpgSQL_arrayelem;
 
 
-typedef struct
-{								/* Item in the compilers namestack	*/
+typedef struct PLpgSQL_nsitem
+{								/* Item in the compilers namespace tree */
 	int			itemtype;
 	int			itemno;
+	struct PLpgSQL_nsitem *prev;
 	char		name[1];		/* actually, as long as needed */
 } PLpgSQL_nsitem;
 
 
-/* XXX: consider adapting this to use List */
-typedef struct PLpgSQL_ns
-{								/* Compiler namestack level		*/
-	int			items_alloc;
-	int			items_used;
-	PLpgSQL_nsitem **items;
-	struct PLpgSQL_ns *upper;
-} PLpgSQL_ns;
-
-
 typedef struct
 {								/* Generic execution node		*/
 	int			cmd_type;
@@ -663,6 +668,8 @@ typedef struct PLpgSQL_function
 	int			tg_nargs_varno;
 	int			tg_argv_varno;
 
+	PLpgSQL_resolve_option resolve_option;
+
 	int			ndatums;
 	PLpgSQL_datum **datums;
 	PLpgSQL_stmt_block *action;
@@ -795,6 +802,8 @@ extern PLpgSQL_plugin **plugin_ptr;
 extern PLpgSQL_function *plpgsql_compile(FunctionCallInfo fcinfo,
 				bool forValidator);
 extern PLpgSQL_function *plpgsql_compile_inline(char *proc_source);
+extern void plpgsql_parser_setup(struct ParseState *pstate,
+								 PLpgSQL_expr *expr);
 extern int	plpgsql_parse_word(const char *word);
 extern int	plpgsql_parse_dblword(const char *word);
 extern int	plpgsql_parse_tripword(const char *word);
@@ -838,19 +847,26 @@ extern HeapTuple plpgsql_exec_trigger(PLpgSQL_function *func,
 extern void plpgsql_xact_cb(XactEvent event, void *arg);
 extern void plpgsql_subxact_cb(SubXactEvent event, SubTransactionId mySubid,
 				   SubTransactionId parentSubid, void *arg);
+extern Oid exec_get_datum_type(PLpgSQL_execstate *estate,
+							   PLpgSQL_datum *datum);
+extern Oid exec_get_rec_fieldtype(PLpgSQL_rec *rec, const char *fieldname,
+					   int *fieldno);
 
 /* ----------
- * Functions for namestack handling in pl_funcs.c
+ * Functions for namespace handling in pl_funcs.c
  * ----------
  */
 extern void plpgsql_ns_init(void);
 extern bool plpgsql_ns_setlocal(bool flag);
 extern void plpgsql_ns_push(const char *label);
 extern void plpgsql_ns_pop(void);
+extern PLpgSQL_nsitem *plpgsql_ns_top(void);
 extern void plpgsql_ns_additem(int itemtype, int itemno, const char *name);
-extern PLpgSQL_nsitem *plpgsql_ns_lookup(const char *name1, const char *name2,
-				  const char *name3, int *names_used);
-extern PLpgSQL_nsitem *plpgsql_ns_lookup_label(const char *name);
+extern PLpgSQL_nsitem *plpgsql_ns_lookup(PLpgSQL_nsitem *ns_cur,
+										 const char *name1, const char *name2,
+										 const char *name3, int *names_used);
+extern PLpgSQL_nsitem *plpgsql_ns_lookup_label(PLpgSQL_nsitem *ns_cur,
+											   const char *name);
 
 /* ----------
  * Other functions in pl_funcs.c
diff --git a/src/test/regress/expected/plpgsql.out b/src/test/regress/expected/plpgsql.out
index 2e97bec42e..5846246b7c 100644
--- a/src/test/regress/expected/plpgsql.out
+++ b/src/test/regress/expected/plpgsql.out
@@ -899,7 +899,7 @@ begin
         declare
 	    rec		record;
 	begin
-	    select into rec * from PLine where slotname = outer.rec.backlink;
+	    select into rec * from PLine where slotname = "outer".rec.backlink;
 	    retval := ''Phone line '' || trim(rec.phonenumber);
 	    if rec.comment != '''' then
 	        retval := retval || '' ('';
@@ -3938,3 +3938,43 @@ LINE 1:  SELECT rtrim(roomno) AS roomno, foo FROM Room ORDER BY room...
                                          ^
 QUERY:   SELECT rtrim(roomno) AS roomno, foo FROM Room ORDER BY roomno
 CONTEXT:  PL/pgSQL function "inline_code_block" line 3 at FOR over SELECT rows
+-- Check variable scoping -- a var is not available in its own or prior
+-- default expressions.
+create function scope_test() returns int as $$
+declare x int := 42;
+begin
+  declare y int := x + 1;
+          x int := x + 2;
+  begin
+    return x * 100 + y;
+  end;
+end;
+$$ language plpgsql;
+select scope_test();
+ scope_test 
+------------
+       4443
+(1 row)
+
+drop function scope_test();
+-- Check handling of conflicts between plpgsql vars and table columns.
+create function conflict_test() returns setof int8_tbl as $$
+declare r record;
+  q1 bigint := 42;
+begin
+  for r in select q1,q2 from int8_tbl loop
+    return next r;
+  end loop;
+end;
+$$ language plpgsql;
+select * from conflict_test();
+ q1 |        q2         
+----+-------------------
+ 42 |               456
+ 42 |  4567890123456789
+ 42 |               123
+ 42 |  4567890123456789
+ 42 | -4567890123456789
+(5 rows)
+
+drop function conflict_test();
diff --git a/src/test/regress/sql/plpgsql.sql b/src/test/regress/sql/plpgsql.sql
index 83cda97d1b..51bfce2e0c 100644
--- a/src/test/regress/sql/plpgsql.sql
+++ b/src/test/regress/sql/plpgsql.sql
@@ -1026,7 +1026,7 @@ begin
         declare
 	    rec		record;
 	begin
-	    select into rec * from PLine where slotname = outer.rec.backlink;
+	    select into rec * from PLine where slotname = "outer".rec.backlink;
 	    retval := ''Phone line '' || trim(rec.phonenumber);
 	    if rec.comment != '''' then
 	        retval := retval || '' ('';
@@ -3135,3 +3135,37 @@ BEGIN
         RAISE NOTICE '%, %', r.roomno, r.comment;
     END LOOP;
 END$$;
+
+-- Check variable scoping -- a var is not available in its own or prior
+-- default expressions.
+
+create function scope_test() returns int as $$
+declare x int := 42;
+begin
+  declare y int := x + 1;
+          x int := x + 2;
+  begin
+    return x * 100 + y;
+  end;
+end;
+$$ language plpgsql;
+
+select scope_test();
+
+drop function scope_test();
+
+-- Check handling of conflicts between plpgsql vars and table columns.
+
+create function conflict_test() returns setof int8_tbl as $$
+declare r record;
+  q1 bigint := 42;
+begin
+  for r in select q1,q2 from int8_tbl loop
+    return next r;
+  end loop;
+end;
+$$ language plpgsql;
+
+select * from conflict_test();
+
+drop function conflict_test();