diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 8305febb654e06297d8da8f46048e13028769367..55a80e7b70392911d3839417b0a509e58b67911d 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -8432,13 +8432,14 @@ intrinsic:	function_udf
                   parser_exception_file( $$, $filename );
                 }
 
-	|	LENGTH OF name {
+	|	LENGTH OF scalar[val] {
                   location_set(@1);
                   $$ = new_tempnumeric_float();
-		  auto r1 = new cbl_refer_t($name);
+		  auto r1 = $val;
                   if( ! intrinsic_call_1($$, LENGTH, r1) ) YYERROR;
                   if( ! dialect_ibm() ) {
-		    yyerrorv("LENGTH OF %s requires '-dialect ibm' option", $name->name);
+		    yyerrorv("LENGTH OF %s requires '-dialect ibm' option",
+			     $val->field->name);
 		  }
 		}
 
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index b2f5f8ab6aa03850e0b57b6b31d19710e8731891..865dd1c11b0d4da8ee4945f43c60c513bf95539c 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -1837,26 +1837,6 @@ new_tempnumeric(void) { return new_temporary(FldNumericBin5); }
 static inline cbl_field_t *
 new_tempnumeric_float(void) { return new_temporary(FldFloat); }
 
-#if 0
-static inline cbl_field_t *
-new_temporary_clone( const cbl_field_t *orig) {
-  cbl_field_type_t type = is_literal(orig)? FldAlphanumeric : orig->type;
-  auto f = new_temporary_imply(type);
-  
-//  f->data = orig->data;
-//  if( orig->type == FldGroup) 
-  {
-    memcpy(f, orig, sizeof(cbl_field_t));
-//    namcpy(f->name, orig->name);
-    f->attr = temporary_e;
-    f->var_decl_node = NULL;
-    f->data_decl_node = NULL;
-  }
-
-  parser_symbol_add(f);
-  return f;
-}  
-#else
 static inline cbl_field_t *
 new_temporary_clone( const cbl_field_t *orig) {
   cbl_field_type_t type = is_literal(orig)? FldAlphanumeric : orig->type;
@@ -1868,7 +1848,6 @@ new_temporary_clone( const cbl_field_t *orig) {
   parser_symbol_add(f);
   return f;
 }  
-#endif
 
 uint32_t
 type_capacity( enum cbl_field_type_t type, uint32_t digits );