From 671d6911af8ba9114babb5b9ff37ec381d8196b9 Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 26 Oct 2010 12:56:43 +0000 Subject: [PATCH] 2010-10-26 Robert Dewar * exp_ch3.adb: Fix typo, comment updates. * namet.adb: Minor comment additions. * einfo.ads: Minor comment update. 2010-10-26 Javier Miranda * einfo.adb (Set_Dispatch_Table_Wrappers): Complete the assertion. 2010-10-26 Robert Dewar * par.adb, par-ch13.adb (Aspect_Specifications_Present): Add Strict parameter. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165955 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/einfo.adb | 7 ++++++- gcc/ada/einfo.ads | 4 +++- gcc/ada/exp_ch3.adb | 13 +++++++++---- gcc/ada/namet.adb | 11 ++++++++--- gcc/ada/par-ch13.adb | 16 ++++++++++++---- gcc/ada/par.adb | 11 +++++++++-- 6 files changed, 47 insertions(+), 15 deletions(-) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index d8b24a3..deb0093 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -3302,7 +3302,12 @@ package body Einfo is procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is begin - pragma Assert (Is_Tagged_Type (Id) and then Is_Base_Type (Id)); + pragma Assert (Is_Tagged_Type (Id) + and then Is_Base_Type (Id) + and then Ekind_In (Id, E_Record_Type, + E_Record_Subtype, + E_Record_Type_With_Private, + E_Record_Subtype_With_Private)); Set_Elist26 (Id, V); end Set_Dispatch_Table_Wrappers; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e69dcea..eda094e 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1651,7 +1651,9 @@ package Einfo is -- Has_Pragma_Pure_Function (Flag179) -- Present in all entities. If set, indicates that a valid pragma -- Pure_Function was given for the entity. In some cases, we need to --- know that Is_Pure was explicitly set using this pragma. +-- know that Is_Pure was explicitly set using this pragma. We also set +-- this flag for some internal entities that we know should be treated +-- as pure for optimization purposes. -- Has_Pragma_Thread_Local_Storage (Flag169) -- Present in all entities. If set, indicates that a valid pragma diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index a4acb24..939b60e 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5861,13 +5861,18 @@ package body Exp_Ch3 is Alternatives => Lst)))); Set_TSS (Typ, Fent); - Set_Is_Pure (Fent); - -- The Pure flag will be reset is the current context is not pure. - -- For optimization purposes and constant-folding, indicate that the - -- Rep_To_Pos function can be considered free of side effects. + -- Set Pure flag (it will be reset if the current context is not Pure). + -- We also pretend there was a pragma Pure_Function so that for purposes + -- of optimization and constant-folding, we will consider the function + -- Pure even if we are not in a Pure context). + + Set_Is_Pure (Fent); Set_Has_Pragma_Pure_Function (Fent); + -- Unless we are in -gnatD mode, where we are debugging generated code, + -- this is an internal entity for which we don't need debug info. + if not Debug_Generated_Code then Set_Debug_Info_Off (Fent); end if; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 63b7104..2842dfd 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -140,9 +140,14 @@ package body Namet is Verbosity : constant Int range 1 .. 3 := 1; pragma Warnings (Off, Verbosity); - -- 1 => print basic summary information - -- 2 => in addition print number of entries per hash chain - -- 3 => in addition print content of entries + -- This constant indicates the level of verbosity in the output from + -- this procedure. Currently this can only be changed by editing the + -- declaration above and recompiling. That's good enough in practice, + -- since we very rarely need to use this debug option. Settings are: + -- + -- 1 => print basic summary information + -- 2 => in addition print number of entries per hash chain + -- 3 => in addition print content of entries Zero : constant Int := Character'Pos ('0'); diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 890a8b4..9cb40fc 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -39,7 +39,9 @@ package body Ch13 is -- Aspect_Specifications_Present -- ----------------------------------- - function Aspect_Specifications_Present return Boolean is + function Aspect_Specifications_Present + (Strict : Boolean := Ada_Version < Ada_2012) return Boolean + is Scan_State : Saved_Scan_State; Result : Boolean; @@ -52,7 +54,12 @@ package body Ch13 is if Token = Tok_Semicolon then Scan; -- past semicolon - if Aspect_Specifications_Present then + -- The recursive test is set Strict, since we already have one + -- error (the unexpected semicolon), so we will ignore that semicolon + -- only if we absolutely definitely have an aspect specification + -- following it. + + if Aspect_Specifications_Present (Strict => True) then Error_Msg_SP ("|extra "";"" ignored"); return True; @@ -79,13 +86,14 @@ package body Ch13 is if Token /= Tok_Identifier then Result := False; - -- In Ada 2012 mode, we are less strict, and we consider that we have + -- This is where we pay attention to the Strict mode. Normally when we + -- are in Ada 2012 mode, Strict is False, and we consider that we have -- an aspect specification if the identifier is an aspect name (even if -- not followed by =>) or the identifier is not an aspect name but is -- followed by =>. P_Aspect_Specifications will generate messages if the -- aspect specification is ill-formed. - elsif Ada_Version >= Ada_2012 then + elsif not Strict then if Get_Aspect_Id (Token_Name) /= No_Aspect then Result := True; else diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 4f360ca..0532ec2 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -848,14 +848,21 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is package Ch13 is function P_Representation_Clause return Node_Id; - function Aspect_Specifications_Present return Boolean; + function Aspect_Specifications_Present + (Strict : Boolean := Ada_Version < Ada_2012) return Boolean; -- This function tests whether the next keyword is WITH followed by -- something that looks reasonably like an aspect specification. If so, -- True is returned. Otherwise False is returned. In either case control -- returns with the token pointer unchanged (i.e. pointing to the WITH -- token in the case where True is returned). This function takes care -- of generating appropriate messages if aspect specifications appear - -- in versions of Ada prior to Ada 2012. + -- in versions of Ada prior to Ada 2012. The parameter strict can be + -- set to True, to be rather strict about considering something to be + -- an aspect speficiation. If Strict is False, then the circuitry is + -- rather more generous in considering something ill-formed to be an + -- attempt at an aspect speciciation. The default is more strict for + -- Ada versions before Ada 2012 (where aspect specifications are not + -- permitted). procedure P_Aspect_Specifications (Decl : Node_Id); -- This subprogram is called with the current token pointing to either a -- 2.7.4