Compiler Explorer

Source code

program output;

uses
  SysUtils;

function is_Signaling(const NaN: Single): Boolean;
begin
  Result := NaN.IsNan and (NaN.Frac and $400000 = 0);
end;

function NaNDetails(const Value: Single): string;
begin
  if value.IsNan then
  begin
    if is_Signaling(value) then
      Result := 'NaN is Signaling'
    else
      Result := 'NaN is Quiet';
  end else
    Result := 'Not a NaN';
end;

procedure MakeSignaling(var NaN: Single);
begin
  NaN.Exp := 255;
  NaN.Frac := NaN.Frac and not (1 shl 22);
  Assert(is_Signaling(NaN));
  Writeln('Correct: ',NaNDetails(NaN),#9, '// Line 28');
end;

// When a NaN is returned from a function the Signal bit is set
function SignalingNaN: Single;
begin
  Result := Single.NaN;
  Result.Frac := 1;
  MakeSignaling(Result);
  Assert(is_Signaling(Result));
  Writeln(#9,'SignalingNaN Returning',#9'// Line 38');
end;

function NestedNaN: Single;
var NaN : Single;
begin
  NaN := SignalingNaN;
  // The quiet bit was set
  Writeln('FIXED!:  ',NaNDetails(NaN),#9, '// Line 46');
  // without returning it from a function it works fine
  MakeSignaling(NaN);
  Writeln('Correct: ',NaNDetails(NaN),#9, '// Line 49');
  Assert(is_Signaling(NaN));
  Writeln(#9,'NestedNaN Returning ',#9,'// Line 51');
  Exit(NaN);
end;

var
    NaN : Single;
begin
  try
    NaN := NestedNaN;
    // The quiet bit was set
    Writeln('FIXED!!: ',NaNDetails(NaN),#9,'// Line 62');
    // without returning it from a function it works fine
    MakeSignaling(NaN);
    Writeln('Correct: ',NaNDetails(NaN),#9,'// Line 65');
    Assert(is_Signaling(NaN));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.