From patchwork Mon Aug 29 12:53:53 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 112041 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 72E8FB6F90 for ; Mon, 29 Aug 2011 22:54:30 +1000 (EST) Received: (qmail 13327 invoked by alias); 29 Aug 2011 12:54:22 -0000 Received: (qmail 13102 invoked by uid 22791); 29 Aug 2011 12:54:19 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 29 Aug 2011 12:53:54 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5AD5D2BAB01; Mon, 29 Aug 2011 08:53:53 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id WBfm+Ou6647J; Mon, 29 Aug 2011 08:53:53 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 48C4E2BAACD; Mon, 29 Aug 2011 08:53:53 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 476B792A55; Mon, 29 Aug 2011 08:53:53 -0400 (EDT) Date: Mon, 29 Aug 2011 08:53:53 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Yannick Moy Subject: [Ada] Adjustments to Alfa mode for types and packing Message-ID: <20110829125353.GA28398@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 Compilation was stopping on errors in Alfa mode due to incorrect generation of a type, and inconsistent treatment of packing. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-29 Yannick Moy * freeze.adb (Freeze_Record_Type): Ignore packing in Alfa mode, like in CodePeer mode. * sem_ch3.adb (Signed_Integer_Type_Declaration): Correct the generation of an explicitly declared type, so that the base types of the original type and this generated type are the same, and a "type" (not a subtype like previously). * errout.adb (Special_Msg_Delete): Do not issue messages "Size too small" in Alfa mode, like in CodePeer mode. * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore rep clauses in Alfa mode. Index: errout.adb =================================================================== --- errout.adb (revision 178155) +++ errout.adb (working copy) @@ -2832,10 +2832,10 @@ elsif Msg = "size for& too small, minimum allowed is ^" then - -- Suppress "size too small" errors in CodePeer mode, since pragma - -- Pack is also ignored in this configuration. + -- Suppress "size too small" errors in CodePeer mode and ALFA mode, + -- since pragma Pack is also ignored in this configuration. - if CodePeer_Mode then + if CodePeer_Mode or ALFA_Mode then return True; -- When a size is wrong for a frozen type there is no explicit size Index: freeze.adb =================================================================== --- freeze.adb (revision 178205) +++ freeze.adb (working copy) @@ -2246,12 +2246,14 @@ and then RM_Size (Rec) >= Scalar_Component_Total_RM_Size - -- Never do implicit packing in CodePeer mode since we don't do - -- any packing in this mode, since this generates over-complex - -- code that confuses CodePeer, and in general, CodePeer does not - -- care about the internal representation of objects. + -- Never do implicit packing in CodePeer or ALFA modes since + -- we don't do any packing in this mode, since this generates + -- over-complex code that confuses static analysis, and in + -- general, neither CodePeer not GNATprove care about the + -- internal representation of objects. and then not CodePeer_Mode + and then not ALFA_Mode then -- If implicit packing enabled, do it @@ -3066,6 +3068,7 @@ and then not Is_Packed (Root_Type (E)) and then not Has_Component_Size_Clause (Root_Type (E)) and then not CodePeer_Mode + and then not ALFA_Mode then Get_Index_Bounds (First_Index (E), Lo, Hi); Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 178205) +++ sem_ch13.adb (working copy) @@ -2004,9 +2004,10 @@ end if; -- Process Ignore_Rep_Clauses option (we also ignore rep clauses in - -- CodePeer mode, since they are not relevant in that context). + -- CodePeer mode or ALFA mode, since they are not relevant in these + -- contexts). - if Ignore_Rep_Clauses or CodePeer_Mode then + if Ignore_Rep_Clauses or CodePeer_Mode or ALFA_Mode then case Id is -- The following should be ignored. They do not affect legality @@ -2026,8 +2027,8 @@ Rewrite (N, Make_Null_Statement (Sloc (N))); return; - -- We do not want too ignore 'Small in CodePeer_Mode, since it - -- has an impact on the exact computations performed. + -- We do not want too ignore 'Small in CodePeer_Mode or ALFA_Mode, + -- since it has an impact on the exact computations performed. -- Perhaps 'Small should also not be ignored by -- Ignore_Rep_Clauses ??? Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 178183) +++ sem_ch3.adb (working copy) @@ -19771,14 +19771,14 @@ if ALFA_Mode then -- If the range of the type is already symmetric with a possible - -- extra negative value, just make the type its own base type. + -- extra negative value, leave it this way. if UI_Le (Lo_Val, Hi_Val) and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val)) or else UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1))) then - Set_Etype (T, T); + null; else declare @@ -19830,7 +19830,8 @@ High_Bound => Ubound)); Analyze (Decl); - Set_Etype (Implicit_Base, Implicit_Base); + Set_Etype (Implicit_Base, Base_Type (Implicit_Base)); + Set_Etype (T, Base_Type (Implicit_Base)); Insert_Before (Parent (Def), Decl); end; end if;