diff options
| author | Dmitriy Anisimkov <anisimko@adacore.com> | 2020-11-27 11:18:46 +0600 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-12-16 08:01:01 -0500 |
| commit | be19b8662bd2601ea761fe5adec3a7ce3940dd7c (patch) | |
| tree | 228046d486e5d591b85d7d4214d0e67395d6f75e /gcc/ada/libgnat | |
| parent | c507c83b324582dc05db91d332b0de4b25c85c07 (diff) | |
| download | gcc-be19b8662bd2601ea761fe5adec3a7ce3940dd7c.zip gcc-be19b8662bd2601ea761fe5adec3a7ce3940dd7c.tar.gz gcc-be19b8662bd2601ea761fe5adec3a7ce3940dd7c.tar.bz2 | |
[Ada] Fix gmem.out corruption by GNAT.Expect
gcc/ada/
* adaint.h (__gnat_in_child_after_fork): New flag to express
child process side after fork call.
* adaint.c (__gnat_portable_spawn): Set flag
__gnat_in_child_after_fork.
* expect.c (__gnat_expect_fork): Set __gnat_in_child_after_fork
to one on child side.
* libgnat/memtrack.adb
(In_Child_After_Fork): Flag to disable memory tracking.
(Allow_Trace): New routine defining if memory should be tracked.
(Alloc, Realloc, Free): Use Allow_Trace in "if" condition
instead of First_Call.
Diffstat (limited to 'gcc/ada/libgnat')
| -rw-r--r-- | gcc/ada/libgnat/memtrack.adb | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/gcc/ada/libgnat/memtrack.adb b/gcc/ada/libgnat/memtrack.adb index bd34796..a5f508d 100644 --- a/gcc/ada/libgnat/memtrack.adb +++ b/gcc/ada/libgnat/memtrack.adb @@ -102,6 +102,9 @@ package body System.Memory is pragma Import (C, OS_Exit, "__gnat_os_exit"); pragma No_Return (OS_Exit); + In_Child_After_Fork : Integer; + pragma Import (C, In_Child_After_Fork, "__gnat_in_child_after_fork"); + procedure fwrite (Ptr : System.Address; Size : size_t; @@ -149,6 +152,24 @@ package body System.Memory is -- themselves do dynamic allocation. We use First_Call flag to avoid -- infinite recursion + function Allow_Trace return Boolean; + pragma Inline (Allow_Trace); + -- Check if the memory trace is allowed + + ----------------- + -- Allow_Trace -- + ----------------- + + function Allow_Trace return Boolean is + begin + if First_Call then + First_Call := False; + return In_Child_After_Fork = 0; + else + return False; + end if; + end Allow_Trace; + ----------- -- Alloc -- ----------- @@ -176,14 +197,12 @@ package body System.Memory is Result := c_malloc (Actual_Size); - if First_Call then + if Allow_Trace then -- Logs allocation call -- format is: -- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn> - First_Call := False; - if Needs_Init then Gmem_Initialize; end if; @@ -243,14 +262,12 @@ package body System.Memory is begin Lock_Task.all; - if First_Call then + if Allow_Trace then -- Logs deallocation call -- format is: -- 'D' <mem addr> <len backtrace> <addr1> ... <addrn> - First_Call := False; - if Needs_Init then Gmem_Initialize; end if; @@ -334,9 +351,7 @@ package body System.Memory is Abort_Defer.all; Lock_Task.all; - if First_Call then - First_Call := False; - + if Allow_Trace then -- We first log deallocation call if Needs_Init then |