Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Есть такой код
const
  CExceptionCode = $406D1388;
type
  THREADNAME_INFO = record
    dwType: DWORD; // must be 0x1000
    szName: PUTF8String; // pointer to name (in user addr space)
    dwThreadID: DWORD; // thread ID (-1=caller thread)
    dwFlags: DWORD; // reserved for future use, must be zero
  end;

procedure SetThreadName(AThreadID: Cardinal; const AName: string);
var
  LInfo: THREADNAME_INFO;
begin
  LInfo.dwType := $1000;
  LInfo.szName := PUTF8String(UTF8String(AName));
  LInfo.dwThreadID := AThreadID;
  LInfo.dwFlags := 0;
  try
    RaiseException(CExceptionCode, 0, SizeOf(LInfo) div SizeOf(DWORD), @LInfo);
  except
    on E: EExternalException do
      if E.ExceptionRecord^.ExceptionCode <> CExceptionCode then
        raise;
  end;
end;
В последнее время в логе стала появляться надпись
External exception 406D1388
Т.е. исключение выходит из этой процедуры и отлавливается вышестоящим обработчиком. Вопрос: как такое может происходить?

Модуль не менялся с августа 2019. Скомпилирован на XE3 под Win64 и до этого работало как часы.

Есть глупое предположение, что что-то поломалось с обновлением Windows, но это из разряда предположить хоть что-нибудь.


С уважением, Vasilisk

Сообщение было отредактировано: 7 июн 21, 21:02
7 июн 21, 21:10    [22332549]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Так, первый кандидат есть. Здесь делают так
RaiseException(MS_VC_EXCEPTION, 0, sizeof(info) / sizeof(ULONG_PTR), (ULONG_PTR*)&info);
sizeof(ULONG_PTR) - это 8 байт для x64. Но до этого все работало в том числе и на x64
7 июн 21, 21:28    [22332554]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Zelius
Member

Откуда: Россия, Москва
Сообщений: 1552
Offtop
Автор знает про это?
7 июн 21, 21:38    [22332557]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Zelius
Автор знает про это?
Знает. Когда писался этот код стандартного еще не было.

К слову, в Rio почти такая же реализация, кроме того, что отлавливаются все исключения
class procedure TThread.NameThreadForDebugging(AThreadName: string; AThreadID: TThreadID);
{$IF Defined(MSWINDOWS)}
type
  TThreadNameInfo = record
    FType: LongWord;     // must be 0x1000
    FName: MarshaledAString;    // pointer to name (in user address space)
    FThreadID: LongWord; // thread ID (-1 indicates caller thread)
    FFlags: LongWord;    // reserved for future use, must be zero
  end;
var
  ThreadNameInfo: TThreadNameInfo;
  M:TMarshaller;
begin
  if IsDebuggerPresent then
  begin
    ThreadNameInfo.FType := $1000;
    ThreadNameInfo.FName := M.AsAnsi(AThreadName).ToPointer;
    ThreadNameInfo.FThreadID := AThreadID;
    ThreadNameInfo.FFlags := 0;

    try
      RaiseException($406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo);
    except
    end;
  end;
end;
7 июн 21, 21:46    [22332559]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Сейчас проверил вот такой код в XE3 и Rio при компиляции под Win64
procedure SetThreadName(AThreadID: Cardinal; const AName: string);
var
  LInfo: THREADNAME_INFO;
begin
  LInfo.dwType := $1000;
  LInfo.szName := PUTF8String(UTF8String(AName));
  LInfo.dwThreadID := AThreadID;
  LInfo.dwFlags := 0;
  RaiseException(CExceptionCode, 0, SizeOf(LInfo) div SizeOf(DWORD), @LInfo);
  LInfo.dwFlags := 555;
end;
исключение вообще не поднимается и выделенная строка без вопросов выполняется. Имя потока тоже меняется

Сообщение было отредактировано: 7 июн 21, 22:00
7 июн 21, 22:02    [22332566]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
GunSmoker
Member

Откуда:
Сообщений: 3233
А разница между первым и последним в чём?

Векторные обработчики никто, случаем, не ставит?
7 июн 21, 23:33    [22332602]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
GunSmoker
А разница между первым и последним в чём?
Полное отсутствие блока try..except
GunSmoker
Векторные обработчики никто, случаем, не ставит?
Санкционировано нет. Вроде джедаи что-то пытаются, но при их отключении ничего не меняется.

Основной вопрос - почему исключение вываливается наружу? И почему я такого поведения не вижу у себя?
8 июн 21, 11:43    [22332745]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6747
_Vasilisk_,

предположения:

1) E не типа EExternalException
2) E.ExceptionRecord^.ExceptionCode <> CExceptionCode
8 июн 21, 11:50    [22332750]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Мимопроходящий
Member

Откуда: бурятский тундрюк, эсквайр
Сообщений: 32405

_Vasilisk_, логируй таки действительный класс исключения.

Posted via ActualForum NNTP Server 1.5

8 июн 21, 11:53    [22332754]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6747
P.S.
а ещё у меня было: исключения игнорировались когда портилась память (запись по неинициализированному указателю)

Сообщение было отредактировано: 8 июн 21, 11:47
8 июн 21, 11:55    [22332757]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Кроик Семён
предположения:
Допустим. Хотя сообщение вот такое

И еще: вот полный код проекта
+
program Test;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

const
  CExceptionCode = $406D1388;
type
  THREADNAME_INFO = record
    dwType: DWORD; // must be 0x1000
    szName: PUTF8String; // pointer to name (in user addr space)
    dwThreadID: DWORD; // thread ID (-1=caller thread)
    dwFlags: DWORD; // reserved for future use, must be zero
  end;

procedure SetThreadName(AThreadID: Cardinal; const AName: string);
var
  LInfo: THREADNAME_INFO;
begin
  LInfo.dwType := $1000;
  LInfo.szName := PUTF8String(UTF8String(AName));
  LInfo.dwThreadID := AThreadID;
  LInfo.dwFlags := 0;
//  try
    RaiseException(CExceptionCode, 0, SizeOf(LInfo) div SizeOf(DWORD), @LInfo);
//  except
//    on E: EExternalException do
//      if E.ExceptionRecord^.ExceptionCode <> CExceptionCode then
//        raise;
//  end;
end;

begin
  SetThreadName(GetCurrentThreadId, 'Main');
  Writeln('Done');
  Readln;
end.
try..except закомментирован. В консоль выводится Done. Почему?
Кроик Семён
а ещё у меня было: исключения игнорировались когда портилась память
У меня это происходит при старте службы, когда одновременно запускается несколько потоков. Как бы этот код работал годами
8 июн 21, 12:11    [22332777]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6747
_Vasilisk_,

два вопроса

1)
SizeOf(PUTF8String) == SizeOf(DWORD) // ??????



2)
SizeOf(THREADNAME_INFO) // меняется ли, если его сделать packed record вместо record ??????


почему спрашиваю, ведь аргумент @LInfo ожидается массивом, т.е. все ячейки должны быть одного размера и без пропусков из-за выравнивания в record

Сообщение было отредактировано: 8 июн 21, 12:33
8 июн 21, 12:37    [22332794]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Итак код:
+
program Test;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

const
  CExceptionCode = $406D1388;
type
  THREADNAME_INFO = record
    dwType: DWORD; // must be 0x1000
    szName: PUTF8String; // pointer to name (in user addr space)
    dwThreadID: DWORD; // thread ID (-1=caller thread)
    dwFlags: DWORD; // reserved for future use, must be zero
  end;

procedure SetThreadName(AThreadID: Cardinal; const AName: string);
var
  LInfo: THREADNAME_INFO;
begin
  LInfo.dwType := $1000;
  LInfo.szName := PUTF8String(UTF8String(AName));
  LInfo.dwThreadID := AThreadID;
  LInfo.dwFlags := 0;
  try
    RaiseException(CExceptionCode, 0, SizeOf(LInfo) div SizeOf(ULONG_PTR), @LInfo);
  except
    on E: EExternalException do begin
      Writeln('Internal catched ', IntToHex(E.ExceptionRecord^.ExceptionCode, 8));
      if E.ExceptionRecord^.ExceptionCode <> CExceptionCode then
        raise;
    end;
  end;
end;

begin
  try
    Writeln('SetThreadName');
    SetThreadName(GetCurrentThreadId, 'Main');
    Writeln('OK');
  except
    on E: Exception do begin
      Writeln(Format('Class: %s, %s, Msg: %s', [E.ClassName, BoolToStr(E is EExternalException, True), E.Message]));
    end;
  end;
  Readln;
end.
Запускаю из под отладчика
SetThreadName
OK
Запускаю не из под отладчика, но скомпилированное под Win32
SetThreadName
Internal catched 406D1388
OK
Запускаю не из под отладчика Win64 приложение
SetThreadName
Internal catched 00000000
Class: EExternalException, True, Msg: External exception 406D1388
И как к этому относиться?

Сделал логирование ExceptionRecord
LRec := E.ExceptionRecord;
Writeln(Format(
  'Code: %.8x, Flags: %.8x, Record: %p, Addr: %p, ParamCount: %u',
  [
    LRec^.ExceptionCode,
    LRec^.ExceptionFlags,
    LRec^.ExceptionRecord,
    LRec^.ExceptionAddress,
    LRec^.NumberParameters
  ]
));
Получил такое
Code: 00000000, Flags: 00000000, Record: 000000000042E398, Addr: 000000000014FDD0, ParamCount: 4217187
Явный мусор.

Компилировал и в XE3 и в Rio
8 июн 21, 12:54    [22332803]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
GunSmoker
Member

Откуда:
Сообщений: 3233
_Vasilisk_
исключение вообще не поднимается и выделенная строка без вопросов выполняется. Имя потока тоже меняется

_Vasilisk_
Запускаю из под отладчика
SetThreadName
OK

Запускаю не из под отладчика
SetThreadName
Internal catched 406D1388
OK


Ну это как раз "as designed". Возбуждение исключения - это сигнал отладчику. Если он подключён - он обрабатывает исключение сразу. Если отладчика нет - то некому обработать исключение, вот оно до except и поднимается.
8 июн 21, 13:05    [22332812]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
GunSmoker
Member

Откуда:
Сообщений: 3233
_Vasilisk_
SetThreadName
Internal catched 00000000
Class: EExternalException, True, Msg: External exception 406D1388


Воспроизводится. Надо глянуть...
8 июн 21, 13:08    [22332814]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Совсем потерялся. На Win2008 вот такой код
on E: EExternalException do begin
  Writeln('Internal catched ', IntToHex(E.ExceptionRecord^.ExceptionCode, 8), ', Dec: ', E.ExceptionRecord^.ExceptionCode);
  LRec := E.ExceptionRecord;
  Writeln(Format('Code: %.8x', [LRec^.ExceptionCode]));
end;
Выводит три различных значения. Как это? Приложение все то же - консольное однопоточное

Сообщение было отредактировано: 8 июн 21, 13:03
8 июн 21, 13:09    [22332815]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
GunSmoker
Member

Откуда:
Сообщений: 3233
Короче, это баг в RTL Delphi. Пиши в QC.

program Test;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

procedure Test;
var
  LInfo: array[0..2] of NativeUInt;
begin
  try
    // Any exception code and any args
    LInfo[0] := 1;
    LInfo[1] := 2;
    LInfo[2] := 3;
    RaiseException($01010101, 0, 3, @LInfo);
  except
    on E: EExternalException do begin
      // Outputs trash
      Writeln('ExceptionCode: ', IntToHex(E.ExceptionRecord^.ExceptionCode, 8));
      Writeln('NumberParameters: ', IntToStr(E.ExceptionRecord^.NumberParameters));
      Writeln('ExceptionInformation[0]: ', IntToStr(E.ExceptionRecord^.ExceptionInformation[0]));
      Writeln('ExceptionInformation[1]: ', IntToStr(E.ExceptionRecord^.ExceptionInformation[1]));
      Writeln('ExceptionInformation[2]: ', IntToStr(E.ExceptionRecord^.ExceptionInformation[2]));
    end;
  end;
end;

begin
  Test;
  Readln;
end.
8 июн 21, 13:28    [22332834]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
GunSmoker
это баг в RTL Delphi
Ты на какой Delphi проверял? На последней?

Если я скажу, что до этого код работал. Могло такое быть?
8 июн 21, 13:50    [22332861]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6747
GunSmoker,

может путаю, но вот это
RaiseException($01010101, 0, 3, @LInfo);


случаем не должно быть
RaiseException($01010101, 0, 3, @LInfo[0]);
8 июн 21, 13:50    [22332862]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6747
а стоп, глупость сморозил, думал о типе string
8 июн 21, 13:54    [22332867]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
Кроик Семён
может путаю, но вот это
Массив статический. Это одно и то же
8 июн 21, 13:54    [22332869]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
GunSmoker
Member

Откуда:
Сообщений: 3233
10.3 Rio, не вижу смысла проверять где-то ещё, если ты говоришь, что аж в XE3 это воспроизводится. Очевидно, никто это не проверял.

_Vasilisk_
Если я скажу, что до этого код работал. Могло такое быть?


Вполне. "Если код работает - это не значит, что он правильный".

Я глубоко не копал, но там ExceptionRecord передаётся по указателю:
    E := EExternalException.CreateFmt(SExternalException, [P.ExceptionCode]);
  end;
  if E is EExternal then EExternal(E).ExceptionRecord := P;

Заметь, что в объекте Delphi правильно указывается код исключения ('External exception 01010101'), но при этом в ER - мусор. Т.е. в объекте Delphi сохраняется указатель на временное положение ER на стеке. Тогда при дальнейшем выполнении тут будет "как повезёт".
8 июн 21, 14:00    [22332875]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 2572
Оформляй, может под тестирование бетт 10.5 решат/успеют пофиксить
8 июн 21, 15:47    [22332961]     Ответить | Цитировать Сообщить модератору
 Re: Игнорирование except блока  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12901
http://quality.embarcadero.com/browse/RSP-34151
8 июн 21, 15:58    [22332967]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить