From patchwork Tue Oct 26 11:03:27 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 69229 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 178C9B70D2 for ; Tue, 26 Oct 2010 22:03:41 +1100 (EST) Received: (qmail 1328 invoked by alias); 26 Oct 2010 11:03:38 -0000 Received: (qmail 1307 invoked by uid 22791); 26 Oct 2010 11:03:36 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 26 Oct 2010 11:03:29 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id A1271CB02F2; Tue, 26 Oct 2010 13:03:27 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id BxkWUToLs8Uk; Tue, 26 Oct 2010 13:03:27 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 8EA4ECB025F; Tue, 26 Oct 2010 13:03:27 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 6D80FD9BB4; Tue, 26 Oct 2010 13:03:27 +0200 (CEST) Date: Tue, 26 Oct 2010 13:03:27 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Properly check violations of machine scalar rules Message-ID: <20101026110327.GA23853@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org (RM 13.4.1(10)) for bids certain record component clauses when the opposite bit order is in effect. The compiler was not properly checking these cases. The following shows the correct messages from violating these rules (compiled with -gnatld7 -gnatj69 -gnat05) 1. with System; use System; 2. package testms is 3. type R is record 4. a : integer; 5. b : integer; 6. end record; 7. for R'Bit_Order use 8. Bit_Order'Val (1 - Bit_Order'Pos (Default_Bit_Order)); 9. for R use record 10. a at 0 range 60 .. 91; | >>> machine scalar rules not followed for "a", last bit (91) exceeds maximum machine scalar size (64), and is not a multiple of Storage_Unit (8) (RM 13.4.1(10)) 11. b at 12 range 64 .. 127; | >>> machine scalar rules not followed for "b", last bit (127) exceeds maximum machine scalar size (64), and first bit (64) is non-zero (RM 13.4.1(10)) 12. end record; 13. end testms; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-26 Robert Dewar * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Properly check RM 13.4.1(10). Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 165944) +++ sem_ch13.adb (working copy) @@ -390,62 +390,69 @@ package body Sem_Ch13 is declare Fbit : constant Uint := Static_Integer (First_Bit (CC)); + Lbit : constant Uint := + Static_Integer (Last_Bit (CC)); begin - -- Case of component with size > max machine scalar + -- Case of component with last bit >= max machine scalar - if Esize (Comp) > Max_Machine_Scalar_Size then + if Lbit >= Max_Machine_Scalar_Size then - -- Must begin on byte boundary + -- This is allowed only if first bit is zero, and + -- last bit + 1 is a multiple of storage unit size. - if Fbit mod SSU /= 0 then - Error_Msg_N - ("illegal first bit value for " - & "reverse bit order", - First_Bit (CC)); - Error_Msg_Uint_1 := SSU; - Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + if Fbit = 0 and then (Lbit + 1) mod SSU = 0 then - Error_Msg_N - ("\must be a multiple of ^ " - & "if size greater than ^", - First_Bit (CC)); + -- This is the case to give a warning if enabled - -- Must end on byte boundary + if Warn_On_Reverse_Bit_Order then + Error_Msg_N + ("multi-byte field specified with " + & " non-standard Bit_Order?", CC); - elsif Esize (Comp) mod SSU /= 0 then - Error_Msg_N - ("illegal last bit value for " - & "reverse bit order", - Last_Bit (CC)); - Error_Msg_Uint_1 := SSU; - Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + if Bytes_Big_Endian then + Error_Msg_N + ("\bytes are not reversed " + & "(component is big-endian)?", CC); + else + Error_Msg_N + ("\bytes are not reversed " + & "(component is little-endian)?", CC); + end if; + end if; - Error_Msg_N - ("\must be a multiple of ^ if size " - & "greater than ^", - Last_Bit (CC)); + -- Give error message for RM 13.4.1(10) violation - -- OK, give warning if enabled + else + Error_Msg_FE + ("machine scalar rules not followed for&", + First_Bit (CC), Comp); - elsif Warn_On_Reverse_Bit_Order then - Error_Msg_N - ("multi-byte field specified with " - & " non-standard Bit_Order?", CC); + Error_Msg_Uint_1 := Lbit; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + Error_Msg_F + ("\last bit (^) exceeds maximum machine " + & "scalar size (^)", + First_Bit (CC)); + + if (Lbit + 1) mod SSU /= 0 then + Error_Msg_Uint_1 := SSU; + Error_Msg_F + ("\and is not a multiple of Storage_Unit (^) " + & "('R'M 13.4.1(10))", + First_Bit (CC)); - if Bytes_Big_Endian then - Error_Msg_N - ("\bytes are not reversed " - & "(component is big-endian)?", CC); else - Error_Msg_N - ("\bytes are not reversed " - & "(component is little-endian)?", CC); + Error_Msg_Uint_1 := Fbit; + Error_Msg_F + ("\and first bit (^) is non-zero " + & "('R'M 13.4.1(10))", + First_Bit (CC)); end if; end if; - -- Case where size is not greater than max machine - -- scalar. For now, we just count these. + -- OK case of machine scalar related component clause, + -- For now, just count them. else Num_CC := Num_CC + 1; @@ -509,17 +516,31 @@ package body Sem_Ch13 is -- Start of processing for Sort_CC begin - -- Collect the component clauses + -- Collect the machine scalar relevant component clauses Num_CC := 0; Comp := First_Component_Or_Discriminant (R); while Present (Comp) loop - if Present (Component_Clause (Comp)) - and then Esize (Comp) <= Max_Machine_Scalar_Size - then - Num_CC := Num_CC + 1; - Comps (Num_CC) := Comp; - end if; + declare + CC : constant Node_Id := Component_Clause (Comp); + + begin + -- Collect only component clauses whose last bit is less + -- than machine scalar size. Any component clause whose + -- last bit exceeds this value does not take part in + -- machine scalar layout considerations. The test for + -- Error_Posted makes sure we exclude component clauses + -- for which we already posted an error. + + if Present (CC) + and then not Error_Posted (Last_Bit (CC)) + and then Static_Integer (Last_Bit (CC)) < + Max_Machine_Scalar_Size + then + Num_CC := Num_CC + 1; + Comps (Num_CC) := Comp; + end if; + end; Next_Component_Or_Discriminant (Comp); end loop;