From b60170728ea74dd615f32a7da11e8291c935ab66 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 Nov 2020 12:27:55 -0500 Subject: [PATCH] [Ada] Enable checks on runtime by default gcc/ada/ * gcc-interface/Makefile.in (GNATLIBFLAGS): Enable checks by default. * libgnat/s-bitfie.ads: Suppress alignment checks. * libgnat/s-bituti.adb: Minor reformatting. * libgnat/s-secsta.adb (SS_Allocate): Support Size = 0. --- gcc/ada/gcc-interface/Makefile.in | 2 +- gcc/ada/libgnat/s-bitfie.ads | 6 ++++++ gcc/ada/libgnat/s-bituti.adb | 1 + gcc/ada/libgnat/s-secsta.adb | 15 +++++++++------ 4 files changed, 17 insertions(+), 7 deletions(-) diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index bdf6ae21144..a6325aa2818 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -110,7 +110,7 @@ NO_INLINE_ADAFLAGS = -fno-inline NO_OMIT_ADAFLAGS = -fno-omit-frame-pointer NO_SIBLING_ADAFLAGS = -fno-optimize-sibling-calls NO_REORDER_ADAFLAGS = -fno-toplevel-reorder -GNATLIBFLAGS = -W -Wall -gnatpg -nostdinc +GNATLIBFLAGS = -W -Wall -gnatg -nostdinc GNATLIBCFLAGS = -g -O2 # Pretend that _Unwind_GetIPInfo is available for the target by default. This # should be autodetected during the configuration of libada and passed down to diff --git a/gcc/ada/libgnat/s-bitfie.ads b/gcc/ada/libgnat/s-bitfie.ads index 4f17a9c19b4..21b72949be5 100644 --- a/gcc/ada/libgnat/s-bitfie.ads +++ b/gcc/ada/libgnat/s-bitfie.ads @@ -47,6 +47,12 @@ package System.Bitfields is pragma Provide_Shift_Operators (Val_2); type Val is mod 2**Val_Bits with Alignment => Val_Bytes; + -- ??? It turns out that enabling checks on the instantiation of + -- System.Bitfield_Utils.G makes a latent visibility bug appear on strict + -- alignment platforms related to alignment checks. Work around it by + -- suppressing these checks explicitly. + + pragma Suppress (Alignment_Check); package Utils is new System.Bitfield_Utils.G (Val, Val_2); procedure Copy_Bitfield diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb index e3bd70a5f73..ef839a885fe 100644 --- a/gcc/ada/libgnat/s-bituti.adb +++ b/gcc/ada/libgnat/s-bituti.adb @@ -317,6 +317,7 @@ package body System.Bitfield_Utils is Get_Val_2 (S_Addr, S_Off, Initial_Size); Initial_Val : constant Val := Get_Bitfield (Initial_Val_2, S_Off, Initial_Size); + begin Set_Bitfield (Initial_Val, D_Addr, D_Off, Initial_Size); diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb index 7ec846281f9..f2d264deb8c 100644 --- a/gcc/ada/libgnat/s-secsta.adb +++ b/gcc/ada/libgnat/s-secsta.adb @@ -587,15 +587,18 @@ package body System.Secondary_Stack is -- Start of processing for SS_Allocate begin - -- It should not be possible to request an allocation of negative or - -- zero size. - - pragma Assert (Storage_Size > 0); - -- Round the requested size up to the nearest multiple of the maximum -- alignment to ensure efficient access. - Mem_Size := Round_Up (Storage_Size); + if Storage_Size = 0 then + Mem_Size := Memory_Alignment; + else + -- It should not be possible to request an allocation of negative + -- size. + + pragma Assert (Storage_Size >= 0); + Mem_Size := Round_Up (Storage_Size); + end if; if Sec_Stack_Dynamic then Allocate_Dynamic (Stack, Mem_Size, Addr); -- 2.30.2