Index: completer.c =================================================================== RCS file: /cvs/src/src/gdb/completer.c,v retrieving revision 1.11 diff -p -u -r1.11 completer.c --- completer.c 24 Mar 2002 00:40:35 -0000 1.11 +++ completer.c 19 Apr 2002 11:14:29 -0000 @@ -283,7 +283,10 @@ location_completer (char *text, char *wo } else { - list = make_symbol_completion_list (symbol_start, word); + /* Try to complete the whole expression first */ + list = make_symbol_completion_list (orig_text, word); + if (!list) + list = make_symbol_completion_list (symbol_start, word); /* If text includes characters which cannot appear in a file name, they cannot be asking for completion on files. */ if (strcspn (text, gdb_completer_file_name_break_characters) == text_len) Index: p-exp.y =================================================================== RCS file: /cvs/src/src/gdb/p-exp.y,v retrieving revision 1.9 diff -p -u -r1.9 p-exp.y --- p-exp.y 18 Apr 2002 15:22:18 -0000 1.9 +++ p-exp.y 19 Apr 2002 11:14:31 -0000 @@ -37,7 +37,8 @@ Foundation, Inc., 59 Temple Place - Suit too messy, particularly when such includes can be inserted at random times by the parser generator. */ -/* Known bugs or limitations: +/* FIXME: there are still 21 shift/reduce conflicts + Other known bugs or limitations: - pascal string operations are not supported at all. - there are some problems with boolean types. - Pascal type hexadecimal constants are not supported @@ -49,7 +50,7 @@ Foundation, Inc., 59 Temple Place - Suit #include "gdb_string.h" #include #include "expression.h" -#include "value.h" +#include "value.h" #include "parser-defs.h" #include "language.h" #include "p-lang.h" @@ -150,9 +151,15 @@ static char * uptok (char *, int); /* YYSTYPE gets defined by %union */ static int parse_number (char *, int, int, YYSTYPE *); + +#define current_type current_parser_expression_type + +static void push_current_type (); +static void pop_current_type (); +static int search_field; %} -%type exp exp1 type_exp start variable qualified_name +%type exp exp1 type_exp start normal_start variable qualified_name %type type typebase /* %type block */ @@ -170,7 +177,8 @@ parse_number (char *, int, int, YYSTYPE Contexts where this distinction is not important can use the nonterminal "name", which matches either NAME or TYPENAME. */ -%token STRING +%token STRING +%token FIELDNAME %token NAME /* BLOCKNAME defined below to give it higher precedence. */ %token TYPENAME %type name @@ -219,15 +227,21 @@ parse_number (char *, int, int, YYSTYPE %% -start : exp1 +start : { current_type = NULL; + search_field = 0; + } + normal_start; + +normal_start : + exp1 | type_exp ; type_exp: type { write_exp_elt_opcode(OP_TYPE); write_exp_elt_type($1); - write_exp_elt_opcode(OP_TYPE);} - ; + write_exp_elt_opcode(OP_TYPE); + current_type = $1; } ; /* Expressions, including the comma operator. */ exp1 : exp @@ -237,10 +251,14 @@ exp1 : exp /* Expressions, not including the comma operator. */ exp : exp '^' %prec UNARY - { write_exp_elt_opcode (UNOP_IND); } + { write_exp_elt_opcode (UNOP_IND); + if (current_type) + current_type = TYPE_TARGET_TYPE (current_type); } exp : '@' exp %prec UNARY - { write_exp_elt_opcode (UNOP_ADDR); } + { write_exp_elt_opcode (UNOP_ADDR); + if (current_type) + current_type = TYPE_POINTER_TYPE (current_type); } exp : '-' exp %prec UNARY { write_exp_elt_opcode (UNOP_NEG); } @@ -258,24 +276,55 @@ exp : DECREMENT '(' exp ')' %prec UNA { write_exp_elt_opcode (UNOP_PREDECREMENT); } ; -exp : exp '.' name +exp : exp '.' { search_field = 1; } + FIELDNAME + /* name */ { write_exp_elt_opcode (STRUCTOP_STRUCT); - write_exp_string ($3); - write_exp_elt_opcode (STRUCTOP_STRUCT); } - ; - -exp : exp '[' exp1 ']' - { write_exp_elt_opcode (BINOP_SUBSCRIPT); } - ; + write_exp_string ($4); + write_exp_elt_opcode (STRUCTOP_STRUCT); + search_field = 0; + if (current_type) + { while (TYPE_CODE (current_type) == TYPE_CODE_PTR) + current_type = TYPE_TARGET_TYPE (current_type); + current_type = lookup_struct_elt_type ( + current_type, $4.ptr, false); }; + } ; +exp : exp '[' + /* We need to save the current_type value */ + { char *arrayname; + int arrayfieldindex; + arrayfieldindex = is_pascal_string_type ( + current_type, NULL, NULL, + NULL, NULL, &arrayname); + if (arrayfieldindex) + { + struct stoken stringsval; + stringsval.ptr = alloca (strlen (arrayname) + 1); + stringsval.length = strlen (arrayname); + strcpy (stringsval.ptr, arrayname); + current_type = TYPE_FIELD_TYPE (current_type, + arrayfieldindex - 1); + write_exp_elt_opcode (STRUCTOP_STRUCT); + write_exp_string (stringsval); + write_exp_elt_opcode (STRUCTOP_STRUCT); + } + push_current_type (); } + exp1 ']' + { pop_current_type (); + write_exp_elt_opcode (BINOP_SUBSCRIPT); + if (current_type) + current_type = TYPE_TARGET_TYPE (current_type); } exp : exp '(' /* This is to save the value of arglist_len being accumulated by an outer function call. */ - { start_arglist (); } + { push_current_type (); + start_arglist (); } arglist ')' %prec ARROW { write_exp_elt_opcode (OP_FUNCALL); write_exp_elt_longcst ((LONGEST) end_arglist ()); - write_exp_elt_opcode (OP_FUNCALL); } + write_exp_elt_opcode (OP_FUNCALL); + pop_current_type (); } ; arglist : @@ -288,7 +337,8 @@ arglist : exp : type '(' exp ')' %prec UNARY { write_exp_elt_opcode (UNOP_CAST); write_exp_elt_type ($1); - write_exp_elt_opcode (UNOP_CAST); } + write_exp_elt_opcode (UNOP_CAST); + current_type = $1; } ; exp : '(' exp1 ')' @@ -567,9 +617,11 @@ variable: name_not_typename write_exp_elt_block (NULL); write_exp_elt_sym (sym); write_exp_elt_opcode (OP_VAR_VALUE); - } + current_type = sym->type; } else if ($1.is_a_field_of_this) { + struct value * this_val; + struct type * this_type; /* Object pascal: it hangs off of `this'. Must not inadvertently convert from a method call to data ref. */ @@ -581,6 +633,18 @@ variable: name_not_typename write_exp_elt_opcode (STRUCTOP_PTR); write_exp_string ($1.stoken); write_exp_elt_opcode (STRUCTOP_PTR); + /* we need type of this */ + this_val = value_of_this (0); + if (this_val) + this_type = this_val->type; + else + this_type = NULL; + if (this_type) + current_type = lookup_struct_elt_type ( + this_type, + $1.stoken.ptr, false); + else + current_type = NULL; } else { @@ -881,6 +945,36 @@ parse_number (p, len, parsed_float, puti return INT; } + +struct type_push +{ + struct type *stored; + struct type_push *next; +}; + +static struct type_push *tp_top = NULL; + +static void push_current_type () +{ + struct type_push *tpnew; + tpnew = (struct type_push *) malloc (sizeof (struct type_push)); + tpnew->next = tp_top; + tpnew->stored = current_type; + current_type = NULL; + tp_top = tpnew; +} + +static void pop_current_type () +{ + struct type_push *tp = tp_top; + if (tp) + { + current_type = tp->stored; + tp_top = tp->next; + xfree (tp); + } +} + struct token { char *operator; @@ -907,8 +1001,8 @@ static const struct token tokentab2[] = {"<>", NOTEQUAL, BINOP_END}, {"<=", LEQ, BINOP_END}, {">=", GEQ, BINOP_END}, - {":=", ASSIGN, BINOP_END} - }; + {":=", ASSIGN, BINOP_END}, + {"::", COLONCOLON, BINOP_END} }; /* Allocate uppercased var */ /* make an uppercased copy of tokstart */ @@ -1147,6 +1241,7 @@ yylex () { tempbuf = (char *) realloc (tempbuf, tempbufsize += 64); } + switch (*tokptr) { case '\0': @@ -1293,25 +1388,37 @@ yylex () char *tmp = copy_name (yylval.sval); struct symbol *sym; int is_a_field_of_this = 0; + int is_a_field = 0; int hextype; - sym = lookup_symbol (tmp, expression_context_block, - VAR_NAMESPACE, - &is_a_field_of_this, - (struct symtab **) NULL); + + if (search_field && current_type) + is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL); + if (is_a_field) + sym = NULL; + else + sym = lookup_symbol (tmp, expression_context_block, + VAR_NAMESPACE, + &is_a_field_of_this, + (struct symtab **) NULL); /* second chance uppercased (as Free Pascal does). */ - if (!sym && !is_a_field_of_this) + if (!sym && !is_a_field_of_this && !is_a_field) { for (i = 0; i <= namelen; i++) { if ((tmp[i] >= 'a' && tmp[i] <= 'z')) tmp[i] -= ('a'-'A'); } - sym = lookup_symbol (tmp, expression_context_block, + if (search_field && current_type) + is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL); + if (is_a_field) + sym = NULL; + else + sym = lookup_symbol (tmp, expression_context_block, VAR_NAMESPACE, &is_a_field_of_this, (struct symtab **) NULL); - if (sym || is_a_field_of_this) + if (sym || is_a_field_of_this || is_a_field) for (i = 0; i <= namelen; i++) { if ((tokstart[i] >= 'a' && tokstart[i] <= 'z')) @@ -1319,7 +1426,7 @@ yylex () } } /* Third chance Capitalized (as GPC does). */ - if (!sym && !is_a_field_of_this) + if (!sym && !is_a_field_of_this && !is_a_field) { for (i = 0; i <= namelen; i++) { @@ -1332,11 +1439,16 @@ yylex () if ((tmp[i] >= 'A' && tmp[i] <= 'Z')) tmp[i] -= ('A'-'a'); } - sym = lookup_symbol (tmp, expression_context_block, + if (search_field && current_type) + is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL); + if (is_a_field) + sym = NULL; + else + sym = lookup_symbol (tmp, expression_context_block, VAR_NAMESPACE, &is_a_field_of_this, (struct symtab **) NULL); - if (sym || is_a_field_of_this) + if (sym || is_a_field_of_this || is_a_field) for (i = 0; i <= namelen; i++) { if (i == 0) @@ -1349,6 +1461,15 @@ yylex () tokstart[i] -= ('A'-'a'); } } + + if (is_a_field) + { + tempbuf = (char *) realloc (tempbuf, namelen + 1); + strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0; + yylval.sval.ptr = tempbuf; + yylval.sval.length = namelen; + return FIELDNAME; + } /* Call lookup_symtab, not lookup_partial_symtab, in case there are no psymtabs (coff, xcoff, or some future change to blow away the psymtabs once once symbols are read). */ @@ -1481,5 +1602,6 @@ void yyerror (msg) char *msg; { - error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); + if (!in_parse_for_type) + error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); } Index: p-lang.c =================================================================== RCS file: /cvs/src/src/gdb/p-lang.c,v retrieving revision 1.5 diff -p -u -r1.5 p-lang.c --- p-lang.c 13 Feb 2002 18:49:30 -0000 1.5 +++ p-lang.c 19 Apr 2002 11:14:31 -0000 @@ -44,7 +44,8 @@ extern void _initialize_pascal_language but this does not happen for Free Pascal nor for GPC. */ int is_pascal_string_type (struct type *type,int *length_pos, - int * length_size, int *string_pos, int *char_size) + int *length_size, int *string_pos, int *char_size, + char **arrayname) { if (TYPE_CODE (type) == TYPE_CODE_STRUCT) { @@ -54,11 +55,17 @@ is_pascal_string_type (struct type *type && strcmp (TYPE_FIELDS (type)[0].name, "length") == 0 && strcmp (TYPE_FIELDS (type)[1].name, "st") == 0) { - *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT; - *length_size = TYPE_FIELD_TYPE (type, 0)->length; - *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; - *char_size = 1; - return 1; + if (length_pos) + *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT; + if (length_size) + *length_size = TYPE_FIELD_TYPE (type, 0)->length; + if (string_pos) + *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; + if (char_size) + *char_size = 1; + if (arrayname) + *arrayname = TYPE_FIELDS (type)[1].name; + return 2; }; /* GNU pascal strings. */ /* Three fields: Capacity, length and schema$ or _p_schema. */ @@ -66,12 +73,18 @@ is_pascal_string_type (struct type *type && strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0 && strcmp (TYPE_FIELDS (type)[1].name, "length") == 0) { - *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; - *length_size = TYPE_FIELD_TYPE (type, 1)->length; - *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT; + if (length_pos) + *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; + if (length_size) + *length_size = TYPE_FIELD_TYPE (type, 1)->length; + if (string_pos) + *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT; /* FIXME: how can I detect wide chars in GPC ?? */ - *char_size = 1; - return 1; + if (char_size) + *char_size = 1; + if (arrayname) + *arrayname = TYPE_FIELDS (type)[1].name; + return 2; }; } return 0; @@ -280,7 +293,7 @@ pascal_create_fundamental_type (struct o 0, "void", objfile); break; case FT_CHAR: - type = init_type (TYPE_CODE_INT, + type = init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 0, "char", objfile); break; Index: p-lang.h =================================================================== RCS file: /cvs/src/src/gdb/p-lang.h,v retrieving revision 1.3 diff -p -u -r1.3 p-lang.h --- p-lang.h 9 Nov 2001 09:48:09 -0000 1.3 +++ p-lang.h 19 Apr 2002 11:14:31 -0000 @@ -38,7 +38,8 @@ extern void pascal_type_print_method_arg /* These are in p-lang.c: */ -extern int is_pascal_string_type (struct type *, int *, int *, int *, int*); +extern int + is_pascal_string_type (struct type *, int *, int *, int *, int *, char **); extern void pascal_printchar (int, struct ui_file *); Index: p-valprint.c =================================================================== RCS file: /cvs/src/src/gdb/p-valprint.c,v retrieving revision 1.9 diff -p -u -r1.9 p-valprint.c --- p-valprint.c 8 Jan 2002 02:09:31 -0000 1.9 +++ p-valprint.c 19 Apr 2002 11:14:31 -0000 @@ -191,7 +191,7 @@ pascal_val_print (struct type *type, cha Pascal strings are mapped to records with lowercase names PM */ if (is_pascal_string_type (elttype, &length_pos, - &length_size, &string_pos, &char_size) + &length_size, &string_pos, &char_size, NULL) && addr != 0) { ULONGEST string_length; @@ -320,7 +320,7 @@ pascal_val_print (struct type *type, cha else { if (is_pascal_string_type (type, &length_pos, &length_size, - &string_pos, &char_size)) + &string_pos, &char_size, NULL)) { len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size); LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0); Index: parse.c =================================================================== RCS file: /cvs/src/src/gdb/parse.c,v retrieving revision 1.22 diff -p -u -r1.22 parse.c --- parse.c 9 Apr 2002 22:14:39 -0000 1.22 +++ parse.c 19 Apr 2002 11:14:31 -0000 @@ -71,6 +71,8 @@ struct expression *expout; int expout_size; int expout_ptr; struct block *expression_context_block; +struct type *current_parser_expression_type; +int in_parse_for_type; struct block *innermost_block; int arglist_len; union type_stack_elt *type_stack; @@ -1187,6 +1189,7 @@ parse_expression (char *string) { register struct expression *exp; exp = parse_exp_1 (&string, 0, 0); + if (*string) error ("Junk after end of expression."); return exp; @@ -1338,6 +1341,17 @@ follow_types (struct type *follow_type) } return follow_type; } + +struct type * +parse_for_type (char *string) +{ + register struct expression *exp; + in_parse_for_type = 1; + exp = parse_exp_1 (&string, 0, 0); + in_parse_for_type = 0; + return current_parser_expression_type; +} + static void build_parse (void); static void Index: parser-defs.h =================================================================== RCS file: /cvs/src/src/gdb/parser-defs.h,v retrieving revision 1.7 diff -p -u -r1.7 parser-defs.h --- parser-defs.h 9 Apr 2002 22:14:39 -0000 1.7 +++ parser-defs.h 19 Apr 2002 11:14:31 -0000 @@ -37,6 +37,9 @@ extern int expout_ptr; extern struct block *expression_context_block; +extern struct type *current_parser_expression_type; +extern int in_parse_for_type; + /* The innermost context required by the stack and register variables we've encountered so far. */ extern struct block *innermost_block; @@ -44,7 +47,7 @@ extern struct block *innermost_block; /* The block in which the most recently discovered symbol was found. FIXME: Should be declared along with lookup_symbol in symtab.h; is not related specifically to parsing. */ -extern struct block *block_found; +extern const struct block *block_found; /* Number of arguments seen so far in innermost function call. */ extern int arglist_len; @@ -144,6 +147,9 @@ extern int pop_type_int (void); extern int length_of_subexp (struct expression *, int); extern struct type *follow_types (struct type *); + +/* Used to find current type at a given point in an expression */ +extern struct type *parse_for_type (char *); /* During parsing of a C expression, the pointer to the next character is in this variable. */ Index: symtab.c =================================================================== RCS file: /cvs/src/src/gdb/symtab.c,v retrieving revision 1.62 diff -p -u -r1.62 symtab.c --- symtab.c 6 Apr 2002 18:28:20 -0000 1.62 +++ symtab.c 19 Apr 2002 11:14:33 -0000 @@ -39,7 +39,7 @@ #include "inferior.h" #include "linespec.h" #include "filenames.h" /* for FILENAME_CMP */ - +#include "parser-defs.h" #include "obstack.h" #include @@ -3208,7 +3208,12 @@ make_symbol_completion_list (char *text, /* Length of sym_text. */ int sym_text_len; - /* Now look for the symbol we are supposed to complete on. + return_val_size = 100; + return_val_index = 0; + return_val = (char **) xmalloc ((return_val_size + 1) * sizeof (char *)); + return_val[0] = NULL; + + /* Now look for the symbol we are supposed to complete on. FIXME: This should be language-specific. */ { char *p; @@ -3258,15 +3263,39 @@ make_symbol_completion_list (char *text, break; } sym_text = p; + if (sym_text > text) + { + /* Try to get the type of the parsed text going up to sym_text */ + struct type *type, *t; + /* char first = *sym_text; + *sym_text = 0; */ + sym_text_len = strlen (sym_text); + type = parse_for_type (text); + /* *sym_text = first; */ + if (type) + { /* We found a type, if it is an agregate type, + try to complete from here */ + enum type_code c = TYPE_CODE (type); + t = type; + if (c == TYPE_CODE_UNION || c == TYPE_CODE_STRUCT) + { + for (j = TYPE_N_BASECLASSES (t); j < TYPE_NFIELDS (t); j++) + { + if (TYPE_FIELD_NAME (t, j)) + { + completion_list_add_name (TYPE_FIELD_NAME (t, j), + sym_text, sym_text_len, text, word); + } + } + return (return_val); + } + } + } } } - sym_text_len = strlen (sym_text); - return_val_size = 100; - return_val_index = 0; - return_val = (char **) xmalloc ((return_val_size + 1) * sizeof (char *)); - return_val[0] = NULL; + sym_text_len = strlen (sym_text); /* Look through the partial symtabs for all symbols which begin by matching SYM_TEXT. Add each one that you find to the list. */