diff options
author | Justin Squirek <squirek@adacore.com> | 2019-07-09 07:55:22 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-09 07:55:22 +0000 |
commit | b3889ffffcde1e75def60c6967247eb56baeb3b8 (patch) | |
tree | 307a91a5499e6e34f7051efcc3e29790d32f5036 /gcc/ada/warnsw.adb | |
parent | a9e470285b505c4eb28cfd4960a4f1541db5dad9 (diff) | |
download | gcc-b3889ffffcde1e75def60c6967247eb56baeb3b8.zip gcc-b3889ffffcde1e75def60c6967247eb56baeb3b8.tar.gz gcc-b3889ffffcde1e75def60c6967247eb56baeb3b8.tar.bz2 |
[Ada] Warning needed on anonymous access type allocators
This patch enhances the compiler to add an optional warning for
allocators of anonymous access types due to the somewhat confusing
runtime accessibility checks that they generate. For more details see RM
3.10.2 sections 14/3, 14.1/3, and 14.2/3.
These warnings can now be enabled with -gnatw_a, disabled with -gnatw_A
and are part of the "all warnings" flag -gnatwa.
------------
-- Source --
------------
-- main.adb
procedure Main is
type Int_Ptr is access all Integer;
Ptr_Obj : Int_Ptr;
Ptr_Not_Null_Obj : not null Int_Ptr := new Integer;
Ptr_Anon_Acc_Obj : not null access Integer :=
new Integer; -- WARNING
procedure Update_Ptr (Item : access Integer) is
begin
Ptr_Obj := Int_Ptr (Item); -- RUNTIME ERROR
end;
procedure Update_Ptr_With_Anonymous_Allocator is
Item : access Integer := new Integer;
begin
Update_Ptr (Item);
end;
type Rec_With_Coextension_A (Disc : access Integer)
is null record;
type Rec_With_Coextension_B (Disc : access Integer) is record
Comp : Integer;
end record;
Obj : Rec_With_Coextension_A :=
(Disc => new Integer'(32)); -- WARNING
procedure Test_Param (Param : access Integer) is
begin
null;
end;
function Test_Simple_Return return access Integer is
begin
return new Integer; -- WARNING
end;
function Test_Coextension_Return_A return Rec_With_Coextension_A is
begin
return (Disc => new Integer); -- WARNING
end;
function Test_Coextension_Return_B return Rec_With_Coextension_B is
begin
return (new Integer, 32); -- WARNING
end;
begin
Test_Param (new Integer); -- WARNING
Test_Param (Param => new Integer); -- WARNING
Update_Ptr_With_Anonymous_Allocator;
end;
-----------------
-- Compilation --
-----------------
$ gnatmake -q -gnatw_a main.adb
$ rm *.ali
$ gnatmake -q -gnatwa -gnatw_A main.adb
$ rm *.ali
$ gnatmake -q -gnatwa main.adb
$ main
main.adb:8:06: warning: use of an anonymous access type allocator
main.adb:16:32: warning: use of an anonymous access type allocator
main.adb:29:15: warning: use of an anonymous access type allocator
main.adb:38:14: warning: use of an anonymous access type allocator
main.adb:43:23: warning: coextension will not be deallocated when
its associated owner is deallocated
main.adb:43:23: warning: use of an anonymous access type allocator
main.adb:48:15: warning: coextension will not be deallocated when
its associated owner is deallocated
main.adb:48:15: warning: use of an anonymous access type allocator
main.adb:52:16: warning: use of an anonymous access type allocator
main.adb:53:25: warning: use of an anonymous access type allocator
main.adb:5:04: warning: variable "Ptr_Obj" is assigned but never read
main.adb:6:04: warning: variable "Ptr_Not_Null_Obj" is not referenced
main.adb:7:04: warning: variable "Ptr_Anon_Acc_Obj" is not referenced
main.adb:16:07: warning: "Item" is not modified, could be declared constant
main.adb:28:04: warning: variable "Obj" is not referenced
main.adb:36:13: warning: function "Test_Simple_Return" is not referenced
main.adb:41:13: warning: function "Test_Coextension_Return_A" is not referenced
main.adb:43:23: warning: coextension will not be deallocated when its
associated owner is deallocated
main.adb:46:13: warning: function "Test_Coextension_Return_B" is not referenced
main.adb:48:15: warning: coextension will not be deallocated when its
associated owner is deallocated
main.adb:5:04: warning: variable "Ptr_Obj" is assigned but never read
main.adb:6:04: warning: variable "Ptr_Not_Null_Obj" is not referenced
main.adb:7:04: warning: variable "Ptr_Anon_Acc_Obj" is not referenced
main.adb:8:06: warning: use of an anonymous access type allocator
main.adb:16:07: warning: "Item" is not modified, could be declared constant
main.adb:16:32: warning: use of an anonymous access type allocator
main.adb:28:04: warning: variable "Obj" is not referenced
main.adb:29:15: warning: use of an anonymous access type allocator
main.adb:36:13: warning: function "Test_Simple_Return" is not referenced
main.adb:38:14: warning: use of an anonymous access type allocator
main.adb:41:13: warning: function "Test_Coextension_Return_A" is not referenced
main.adb:43:23: warning: coextension will not be deallocated when its
associated owner is deallocated
main.adb:43:23: warning: use of an anonymous access type allocator
main.adb:46:13: warning: function "Test_Coextension_Return_B" is not referenced
main.adb:48:15: warning: coextension will not be deallocated when its
associated owner is deallocated
main.adb:48:15: warning: use of an anonymous access type allocator
main.adb:52:16: warning: use of an anonymous access type allocator
main.adb:53:25: warning: use of an anonymous access type allocator
raised PROGRAM_ERROR : main.adb:12 accessibility check failed
2019-07-09 Justin Squirek <squirek@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_N_Allocator): Add conditional to detect
the presence of anoymous access type allocators and issue a
warning if the appropriate warning flag is enabled.
* warnsw.ads: Add new warning flag for anonymous allocators
* warnsw.adb (All_Warnings, Restore_Warnings, Save_Warnings,
Set_Underscore_Warning_Switch): Register new flags.
(WA_Warnings): Register new flag as an "all warnings" switch
* usage.adb,
doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Document new warning switches -gnatw_a and -gnatw_A.
* gnat_ugn.texi: Regenerate.
From-SVN: r273290
Diffstat (limited to 'gcc/ada/warnsw.adb')
-rw-r--r-- | gcc/ada/warnsw.adb | 12 |
1 files changed, 12 insertions, 0 deletions
diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 472f1df..219d440 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -56,6 +56,7 @@ package body Warnsw is Warn_On_Ada_2005_Compatibility := Setting; Warn_On_Ada_2012_Compatibility := Setting; Warn_On_All_Unread_Out_Parameters := Setting; + Warn_On_Anonymous_Allocators := Setting; Warn_On_Assertion_Failure := Setting; Warn_On_Assumed_Low_Bound := Setting; Warn_On_Atomic_Synchronization := Setting; @@ -129,6 +130,8 @@ package body Warnsw is W.Warn_On_Ada_2012_Compatibility; Warn_On_All_Unread_Out_Parameters := W.Warn_On_All_Unread_Out_Parameters; + Warn_On_Anonymous_Allocators := + W.Warn_On_Anonymous_Allocators; Warn_On_Assertion_Failure := W.Warn_On_Assertion_Failure; Warn_On_Assumed_Low_Bound := @@ -235,6 +238,8 @@ package body Warnsw is Warn_On_Ada_2012_Compatibility; W.Warn_On_All_Unread_Out_Parameters := Warn_On_All_Unread_Out_Parameters; + W.Warn_On_Anonymous_Allocators := + Warn_On_Anonymous_Allocators; W.Warn_On_Assertion_Failure := Warn_On_Assertion_Failure; W.Warn_On_Assumed_Low_Bound := @@ -478,6 +483,12 @@ package body Warnsw is function Set_Underscore_Warning_Switch (C : Character) return Boolean is begin case C is + when 'a' => + Warn_On_Anonymous_Allocators := True; + + when 'A' => + Warn_On_Anonymous_Allocators := False; + when others => if Ignore_Unrecognized_VWY_Switches then Write_Line ("unrecognized switch -gnatw_" & C & " ignored"); @@ -705,6 +716,7 @@ package body Warnsw is Ineffective_Inline_Warnings := True; -- -gnatwp Warn_On_Ada_2005_Compatibility := True; -- -gnatwy Warn_On_Ada_2012_Compatibility := True; -- -gnatwy + Warn_On_Anonymous_Allocators := True; -- -gnatw_a Warn_On_Assertion_Failure := True; -- -gnatw.a Warn_On_Assumed_Low_Bound := True; -- -gnatww Warn_On_Bad_Fixed_Value := True; -- -gnatwb |