The compiler fails to generate a call to detect allocators executed after
elaboration in cases where the allocator is associated with Global_Pool_Object.
The fix is to test for this associated storage pool as part of the condition
for generating a call to System.Elaboration_Allocators.Check_Standard_Alloctor.
Also, the exception Storage_Error is now generated instead of Program_Error
for such a run-time violation, as required by the Ada RM in D.7.
The following test must compile and execute quietly:
-- Put the pragma in gnat.adc:
pragma Restrictions (No_Standard_Allocators_After_Elaboration);
package Pkg_With_Allocators is
type Priv is private;
procedure Allocate
(Use_Global_Allocator : Boolean;
During_Elaboration : Boolean);
private
type Rec is record
Int : Integer;
end record;
type Priv is access Rec;
end Pkg_With_Allocators;
package body Pkg_With_Allocators is
Ptr : Priv;
procedure Allocate
(Use_Global_Allocator : Boolean;
During_Elaboration : Boolean)
is
type Local_Acc is access Rec;
Local_Ptr : Local_Acc;
begin
if Use_Global_Allocator then
Ptr := new Rec; -- Raise Storage_Error if after elaboration
Ptr.Int := 1;
else
Local_Ptr := new Rec; -- Raise Storage_Error if after elaboration
Local_Ptr.Int := 1;
end if;
if not During_Elaboration then
raise Program_Error; -- No earlier exception: FAIL
end if;
exception
when Storage_Error =>
if During_Elaboration then
raise Program_Error; -- No exception expected: FAIL
else
null; -- Expected Storage_Error: PASS
end if;
when others =>
raise Program_Error; -- Unexpected exception: FAIL
end Allocate;
begin
Allocate (Use_Global_Allocator => True, During_Elaboration => True);
Allocate (Use_Global_Allocator => False, During_Elaboration => True);
end Pkg_With_Allocators;
with Pkg_With_Allocators;
procedure Alloc_Restriction_Main is
begin
Pkg_With_Allocators.Allocate
(Use_Global_Allocator => True,
During_Elaboration => False);
Pkg_With_Allocators.Allocate
(Use_Global_Allocator => False,
During_Elaboration => False);
end Alloc_Restriction_Main;
2018-07-16 Gary Dismukes <dismukes@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_N_Allocator): Test for Storage_Pool being RTE in
addition to the existing test for no Storage_Pool as a condition
enabling generation of the call to Check_Standard_Allocator when the
restriction No_Standard_Allocators_After_Elaboration is active.
* libgnat/s-elaall.ads (Check_Standard_Allocator): Correct comment to
say that Storage_Error will be raised (rather than Program_Error).
* libgnat/s-elaall.adb (Check_Standard_Allocator): Raise Storage_Error
rather than Program_Error when Elaboration_In_Progress is False.
From-SVN: r262700
| Name |
Last commit
|
Last update |
|---|---|---|
| INSTALL | Loading commit data... | |
| config | Loading commit data... | |
| contrib | Loading commit data... | |
| fixincludes | Loading commit data... | |
| gcc | Loading commit data... | |
| gnattools | Loading commit data... | |
| gotools | Loading commit data... | |
| include | Loading commit data... | |
| intl | Loading commit data... | |
| libada | Loading commit data... | |
| libatomic | Loading commit data... | |
| libbacktrace | Loading commit data... | |
| libcc1 | Loading commit data... | |
| libcpp | Loading commit data... | |
| libdecnumber | Loading commit data... | |
| libffi | Loading commit data... | |
| libgcc | Loading commit data... | |
| libgfortran | Loading commit data... | |
| libgo | Loading commit data... | |
| libgomp | Loading commit data... | |
| libhsail-rt | Loading commit data... | |
| libiberty | Loading commit data... | |
| libitm | Loading commit data... | |
| libobjc | Loading commit data... | |
| liboffloadmic | Loading commit data... | |
| libquadmath | Loading commit data... | |
| libsanitizer | Loading commit data... | |
| libssp | Loading commit data... | |
| libstdc++-v3 | Loading commit data... | |
| libvtv | Loading commit data... | |
| lto-plugin | Loading commit data... | |
| maintainer-scripts | Loading commit data... | |
| zlib | Loading commit data... | |
| .dir-locals.el | Loading commit data... | |
| .gitattributes | Loading commit data... | |
| .gitignore | Loading commit data... | |
| ABOUT-NLS | Loading commit data... | |
| COPYING | Loading commit data... | |
| COPYING.LIB | Loading commit data... | |
| COPYING.RUNTIME | Loading commit data... | |
| COPYING3 | Loading commit data... | |
| COPYING3.LIB | Loading commit data... | |
| ChangeLog | Loading commit data... | |
| ChangeLog.jit | Loading commit data... | |
| ChangeLog.tree-ssa | Loading commit data... | |
| MAINTAINERS | Loading commit data... | |
| Makefile.def | Loading commit data... | |
| Makefile.in | Loading commit data... | |
| Makefile.tpl | Loading commit data... | |
| README | Loading commit data... | |
| compile | Loading commit data... | |
| config-ml.in | Loading commit data... | |
| config.guess | Loading commit data... | |
| config.rpath | Loading commit data... | |
| config.sub | Loading commit data... | |
| configure | Loading commit data... | |
| configure.ac | Loading commit data... | |
| depcomp | Loading commit data... | |
| install-sh | Loading commit data... | |
| libtool-ldflags | Loading commit data... | |
| libtool.m4 | Loading commit data... | |
| ltgcc.m4 | Loading commit data... | |
| ltmain.sh | Loading commit data... | |
| ltoptions.m4 | Loading commit data... | |
| ltsugar.m4 | Loading commit data... | |
| ltversion.m4 | Loading commit data... | |
| lt~obsolete.m4 | Loading commit data... | |
| missing | Loading commit data... | |
| mkdep | Loading commit data... | |
| mkinstalldirs | Loading commit data... | |
| move-if-change | Loading commit data... | |
| symlink-tree | Loading commit data... | |
| ylwrap | Loading commit data... |