gcc version 4.3.1 ada exception bug from foreign code?

[debian-gcc@coreland.ath.cx]

Hello.

I've hit a wall which I believe to be a bug in GCC 4.3.1.

Essentially, a piece of Ada code calls a foreign C function with
a callback as an argument. The callback is an Ada procedure which
raises an exception. The original Ada caller catches the exception
and execution continues from that point.

That's what *should* happen (and does on the other platforms I've tested
on).

However, on lenny/sid with GCC 4.3.1, it seems that the exception never
leaves the innermost callback, instead printing an error message to
stderr as if an unhandled exception had reached the outermost point
of the program:

  raised EXCEPT.TEST_ERROR : this should have been caught

Here's a code example:

/* cpart.c */

#include <stdio.h>
#include <stdlib.h>

void (*raiser_callback)(const char *str) = NULL;

void
cpart_set (void (*callback)(const char *str))
{
  raiser_callback = callback;
}

void
cpart_raise (const char *str)
{
  printf ("-- C %s\n", __func__);
  raiser_callback (str);
  printf ("-- C %s - should not be here\n", __func__);
  abort (); /* not reached */
}

-- except.adb

with interfaces.c.strings;
with ada.text_io;
with ada.exceptions;

procedure except is
  package io renames ada.text_io;
  package ex renames ada.exceptions;
  package cs renames interfaces.c.strings;

  test_error : exception;

  procedure ada_raiser (str : cs.chars_ptr) is
  begin
    io.put_line ("-- Ada ada_raiser");
    raise test_error with cs.value (str);
  end ada_raiser;

  procedure cpart_raise (str : cs.chars_ptr);
  procedure cpart_set (callback : access procedure (str : cs.chars_ptr));
  pragma import (c, cpart_raise, "cpart_raise");
  pragma import (c, cpart_set, "cpart_set");

  message : cs.chars_ptr := cs.new_string ("this should have been caught");
begin
  io.put_line ("-- Ada begin");

  -- set callback for exception raising
  cpart_set (ada_raiser'access);
  begin
    cpart_raise (message);
  exception
    -- exception handling section here is not reached, process exits
    when e : test_error =>
      io.put_line ("caught test_error: " & ex.exception_message (e));
  end;

  -- execution never reaches this line
  io.put_line ("-- Ada end");
end except;

Any help would be appreciated (even confirmation that this isn't my fault
would be nice).