2010-10-26 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 26 Oct 2010 12:56:43 +0000 (12:56 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 26 Oct 2010 12:56:43 +0000 (12:56 +0000)
* exp_ch3.adb: Fix typo, comment updates.
* namet.adb: Minor comment additions.
* einfo.ads: Minor comment update.

2010-10-26  Javier Miranda  <miranda@adacore.com>

* einfo.adb (Set_Dispatch_Table_Wrappers): Complete the assertion.

2010-10-26  Robert Dewar  <dewar@adacore.com>

* 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
gcc/ada/einfo.ads
gcc/ada/exp_ch3.adb
gcc/ada/namet.adb
gcc/ada/par-ch13.adb
gcc/ada/par.adb

index d8b24a3..deb0093 100644 (file)
@@ -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;
 
index e69dcea..eda094e 100644 (file)
@@ -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
index a4acb24..939b60e 100644 (file)
@@ -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;
index 63b7104..2842dfd 100644 (file)
@@ -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');
 
index 890a8b4..9cb40fc 100644 (file)
@@ -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
index 4f360ca..0532ec2 100644 (file)
@@ -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