Re: [PATCH] avoid GDB crash on inspection of pascal arrays

[Joel Brobecker <brobecker@adacore.com>]

[-- Attachment #1: Type: text/plain, Size: 76 bytes --]

> Attached is a couple of patches:

[with the patches, this time]

-- 
Joel

[-- Attachment #2: p-valprint-reformat.diff --]
[-- Type: text/x-diff, Size: 6921 bytes --]

diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 260b97d..3bc9c55 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -151,105 +151,105 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 	  break;
 	}
       elttype = check_typedef (TYPE_TARGET_TYPE (type));
-	{
-	  addr = unpack_pointer (type, valaddr + embedded_offset);
-	print_unpacked_pointer:
-	  elttype = check_typedef (TYPE_TARGET_TYPE (type));
-
-	  if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
-	    {
-	      /* Try to print what function it points to.  */
-	      print_address_demangle (gdbarch, addr, stream, demangle);
-	      /* Return value is irrelevant except for string pointers.  */
-	      return (0);
-	    }
 
-	  if (options->addressprint && options->format != 's')
-	    {
-	      fputs_filtered (paddress (gdbarch, addr), stream);
-	    }
+      addr = unpack_pointer (type, valaddr + embedded_offset);
+    print_unpacked_pointer:
+      elttype = check_typedef (TYPE_TARGET_TYPE (type));
 
-	  /* For a pointer to char or unsigned char, also print the string
-	     pointed to, unless pointer is null.  */
-	  if (((TYPE_LENGTH (elttype) == 1
-	       && (TYPE_CODE (elttype) == TYPE_CODE_INT
-		  || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
-	      || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
-		  && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
-	      && (options->format == 0 || options->format == 's')
-	      && addr != 0)
-	    {
-	      /* no wide string yet */
-	      i = val_print_string (elttype, addr, -1, stream, options);
-	    }
-	  /* also for pointers to pascal strings */
-	  /* Note: this is Free Pascal specific:
-	     as GDB does not recognize stabs pascal strings
-	     Pascal strings are mapped to records
-	     with lowercase names PM  */
-          if (is_pascal_string_type (elttype, &length_pos, &length_size,
-                                     &string_pos, &char_type, NULL)
-	      && addr != 0)
+      if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
+	{
+	  /* Try to print what function it points to.  */
+	  print_address_demangle (gdbarch, addr, stream, demangle);
+	  /* Return value is irrelevant except for string pointers.  */
+	  return (0);
+	}
+
+      if (options->addressprint && options->format != 's')
+	{
+	  fputs_filtered (paddress (gdbarch, addr), stream);
+	}
+
+      /* For a pointer to char or unsigned char, also print the string
+	 pointed to, unless pointer is null.  */
+      if (((TYPE_LENGTH (elttype) == 1
+	   && (TYPE_CODE (elttype) == TYPE_CODE_INT
+	      || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
+	  || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
+	      && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
+	  && (options->format == 0 || options->format == 's')
+	  && addr != 0)
+	{
+	  /* no wide string yet */
+	  i = val_print_string (elttype, addr, -1, stream, options);
+	}
+      /* also for pointers to pascal strings */
+      /* Note: this is Free Pascal specific:
+	 as GDB does not recognize stabs pascal strings
+	 Pascal strings are mapped to records
+	 with lowercase names PM  */
+      if (is_pascal_string_type (elttype, &length_pos, &length_size,
+				 &string_pos, &char_type, NULL)
+	  && addr != 0)
+	{
+	  ULONGEST string_length;
+	  void *buffer;
+	  buffer = xmalloc (length_size);
+	  read_memory (addr + length_pos, buffer, length_size);
+	  string_length = extract_unsigned_integer (buffer, length_size,
+						    byte_order);
+	  xfree (buffer);
+	  i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
+	}
+      else if (pascal_object_is_vtbl_member (type))
+	{
+	  /* print vtbl's nicely */
+	  CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
+
+	  struct minimal_symbol *msymbol =
+	  lookup_minimal_symbol_by_pc (vt_address);
+	  if ((msymbol != NULL)
+	      && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
 	    {
-	      ULONGEST string_length;
-              void *buffer;
-              buffer = xmalloc (length_size);
-              read_memory (addr + length_pos, buffer, length_size);
-	      string_length = extract_unsigned_integer (buffer, length_size,
-							byte_order);
-              xfree (buffer);
-              i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
+	      fputs_filtered (" <", stream);
+	      fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
+	      fputs_filtered (">", stream);
 	    }
-	  else if (pascal_object_is_vtbl_member (type))
+	  if (vt_address && options->vtblprint)
 	    {
-	      /* print vtbl's nicely */
-	      CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
+	      struct value *vt_val;
+	      struct symbol *wsym = (struct symbol *) NULL;
+	      struct type *wtype;
+	      struct block *block = (struct block *) NULL;
+	      int is_this_fld;
+
+	      if (msymbol != NULL)
+		wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
+				      VAR_DOMAIN, &is_this_fld);
 
-	      struct minimal_symbol *msymbol =
-	      lookup_minimal_symbol_by_pc (vt_address);
-	      if ((msymbol != NULL)
-		  && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
+	      if (wsym)
 		{
-		  fputs_filtered (" <", stream);
-		  fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
-		  fputs_filtered (">", stream);
+		  wtype = SYMBOL_TYPE (wsym);
 		}
-	      if (vt_address && options->vtblprint)
+	      else
 		{
-		  struct value *vt_val;
-		  struct symbol *wsym = (struct symbol *) NULL;
-		  struct type *wtype;
-		  struct block *block = (struct block *) NULL;
-		  int is_this_fld;
-
-		  if (msymbol != NULL)
-		    wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
-					  VAR_DOMAIN, &is_this_fld);
-
-		  if (wsym)
-		    {
-		      wtype = SYMBOL_TYPE (wsym);
-		    }
-		  else
-		    {
-		      wtype = TYPE_TARGET_TYPE (type);
-		    }
-		  vt_val = value_at (wtype, vt_address);
-		  common_val_print (vt_val, stream, recurse + 1, options,
-				    current_language);
-		  if (options->pretty)
-		    {
-		      fprintf_filtered (stream, "\n");
-		      print_spaces_filtered (2 + 2 * recurse, stream);
-		    }
+		  wtype = TYPE_TARGET_TYPE (type);
+		}
+	      vt_val = value_at (wtype, vt_address);
+	      common_val_print (vt_val, stream, recurse + 1, options,
+				current_language);
+	      if (options->pretty)
+		{
+		  fprintf_filtered (stream, "\n");
+		  print_spaces_filtered (2 + 2 * recurse, stream);
 		}
 	    }
-
-	  /* Return number of characters printed, including the terminating
-	     '\0' if we reached the end.  val_print_string takes care including
-	     the terminating '\0' if necessary.  */
-	  return i;
 	}
+
+      /* Return number of characters printed, including the terminating
+	 '\0' if we reached the end.  val_print_string takes care including
+	 the terminating '\0' if necessary.  */
+      return i;
+
       break;
 
     case TYPE_CODE_REF:

[-- Attachment #3: p-valprint-reformat-w.diff --]
[-- Type: text/x-diff, Size: 691 bytes --]

diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 260b97d..3bc9c55 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -151,7 +151,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 	  break;
 	}
       elttype = check_typedef (TYPE_TARGET_TYPE (type));
-	{
+
 	  addr = unpack_pointer (type, valaddr + embedded_offset);
 	print_unpacked_pointer:
 	  elttype = check_typedef (TYPE_TARGET_TYPE (type));
@@ -249,7 +249,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 	     '\0' if we reached the end.  val_print_string takes care including
 	     the terminating '\0' if necessary.  */
 	  return i;
-	}
+
       break;
 
     case TYPE_CODE_REF: