sinput.adb (Expr_Last_Char): Fix some copy-paste errors for paren skipping.

2009-05-06  Robert Dewar  <dewar@adacore.com>

	* sinput.adb (Expr_Last_Char): Fix some copy-paste errors for paren
	skipping.
	(Expr_First_Char): Add ??? comment that paren skipping needs work
	(Expr_Last_Char): Add ??? comment that paren skipping needs work

	* exp_attr.adb: Add processing for Compiler_Version

	* sem_attr.adb: New attribute Compiler_Version

	* snames.ads-tmpl: Add entries for Compiler_Version attribute

	* gnat_rm.texi: Document Compiler_Version attribute

From-SVN: r147181

gcc/ada/ChangeLog

 2009-05-06  Robert Dewar  <dewar@adacore.com>
 
+	* sinput.adb (Expr_Last_Char): Fix some copy-paste errors for paren
+	skipping.
+	(Expr_First_Char): Add ??? comment that paren skipping needs work
+	(Expr_Last_Char): Add ??? comment that paren skipping needs work
+
+	* exp_attr.adb: Add processing for Compiler_Version
+
+	* sem_attr.adb: New attribute Compiler_Version
+
+	* snames.ads-tmpl: Add entries for Compiler_Version attribute
+
+	* gnat_rm.texi: Document Compiler_Version attribute
+
+2009-05-06  Robert Dewar  <dewar@adacore.com>
+
 	* errout.adb: Minor reformatting
 
 	* scng.adb, sem_prag.adb, par-ch4.adb, sem_res.adb, par-ch6.adb,

gcc/ada/exp_attr.adb

@@ -5238,6 +5238,7 @@ package body Exp_Attr is
            Attribute_Address_Size                 |
            Attribute_Base                         |
            Attribute_Class                        |
+           Attribute_Compiler_Version             |
            Attribute_Default_Bit_Order            |
            Attribute_Delta                        |
            Attribute_Denorm                       |

gcc/ada/gnat_rm.texi

@@ -222,6 +222,7 @@ Implementation Defined Attributes
 * AST_Entry::
 * Bit::
 * Bit_Position::
+* Compiler_Version::
 * Code_Address::
 * Default_Bit_Order::
 * Elaborated::
@@ -5352,6 +5353,7 @@ consideration, you should minimize the use of these attributes.
 * AST_Entry::
 * Bit::
 * Bit_Position::
+* Compiler_Version::
 * Code_Address::
 * Default_Bit_Order::
 * Elaborated::
@@ -5504,6 +5506,15 @@ type @code{Universal_Integer}.  The value depends only on the field
 @var{C} and is independent of the alignment of
 the containing record @var{R}.
 
+@node Compiler_Version
+@unnumberedsec Compiler_Version
+@findex Compiler_Version
+@noindent
+@code{Standard'Compiler_Version} (@code{Standard} is the only allowed
+prefix) yields a static string identifying the version of the compiler
+being used to compile the unit containing the attribute reference. A
+typical result would be something like "GNAT Pro 6.3.0w (20090221)".
+
 @node Code_Address
 @unnumberedsec Code_Address
 @findex Code_Address

gcc/ada/sem_attr.adb

@@ -35,6 +35,7 @@ with Exp_Dist; use Exp_Dist;
 with Exp_Util; use Exp_Util;
 with Expander; use Expander;
 with Freeze;   use Freeze;
+with Gnatvsn;  use Gnatvsn;
 with Itypes;   use Itypes;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
@@ -2544,6 +2545,16 @@ package body Sem_Attr is
 
          Set_Etype (N, RTE (RE_Address));
 
+      ----------------------
+      -- Compiler_Version --
+      ----------------------
+
+      when Attribute_Compiler_Version =>
+         Check_E0;
+         Check_Standard_Prefix;
+         Rewrite (N, Make_String_Literal (Loc, Gnat_Static_Version_String));
+         Analyze_And_Resolve (N, Standard_String);
+
       --------------------
       -- Component_Size --
       --------------------
@@ -7482,6 +7493,7 @@ package body Sem_Attr is
            Attribute_Caller                   |
            Attribute_Class                    |
            Attribute_Code_Address             |
+           Attribute_Compiler_Version         |
            Attribute_Count                    |
            Attribute_Default_Bit_Order        |
            Attribute_Elaborated               |

gcc/ada/sinput.adb

@@ -317,6 +317,11 @@ package body Sinput is
 
                Loc := Sloc (N);
 
+               --  Skip past parens
+
+               --  This is not right, it does not deal with skipping comments
+               --  and probably also has wide character problems ???
+
                if Count > 0 then
                   declare
                      SFI : constant Source_File_Index :=
@@ -408,7 +413,7 @@ package body Sinput is
                  N_Conditional_Expression    =>
                raise Program_Error;
 
-            --  Cases where the Sloc points to the start of the tokem, but we
+            --  Cases where the Sloc points to the start of the token, but we
             --  still need to handle the sequence of left parentheses.
 
             when N_Identifier          |
@@ -425,25 +430,44 @@ package body Sinput is
 
                Loc := Sloc (N);
 
-               if Count > 0 then
-                  declare
-                     SFI : constant Source_File_Index :=
-                             Get_Source_File_Index (Loc);
-                     Src : constant Source_Buffer_Ptr := Source_Text (SFI);
-                     Fst : constant Source_Ptr        := Source_Last (SFI);
+               --  Now we have two tasks, first we are pointing to the start
+               --  of the token below, second, we need to skip parentheses.
 
-                  begin
+               --  Skipping to the end of a token is not easy, we can't just
+               --  skip to a space, since we may have e.g. X*YAR+Z, and if we
+               --  are finding the end of the subexpression X*YAR, we don't
+               --  want to skip past the +Z. Also we have to worry about
+               --  skipping comments, and about wide characters ???
+
+               declare
+                  SFI : constant Source_File_Index :=
+                          Get_Source_File_Index (Loc);
+                  Src : constant Source_Buffer_Ptr := Source_Text (SFI);
+                  Lst : constant Source_Ptr        := Source_Last (SFI);
+
+               begin
+                  --  Scan through first blank character, to get to the end
+                  --  of this token. As noted above that's not really right???
+
+                  loop
+                     exit when Loc = Lst or else Src (Loc + 1) <= ' ';
+                     Loc := Loc + 1;
+                  end loop;
+
+                  --  Skip past parens, but this also ignores comments ???
+
+                  if Count > 0 then
                      for J in 1 .. Count loop
                         loop
-                           exit when Loc = Fst;
-                           Loc := Loc - 1;
+                           exit when Loc = Lst;
+                           Loc := Loc + 1;
                            exit when Src (Loc) >= ' ';
                         end loop;
 
-                        exit when Src (Loc) /= '(';
+                        exit when Src (Loc) /= ')';
                      end loop;
-                  end;
-               end if;
+                  end if;
+               end;
 
                return Loc;
          end case;

gcc/ada/snames.ads-tmpl

@@ -688,6 +688,7 @@ package Snames is
    Name_Callable                       : constant Name_Id := N + $;
    Name_Caller                         : constant Name_Id := N + $;
    Name_Code_Address                   : constant Name_Id := N + $; -- GNAT
+   Name_Compiler_Version               : constant Name_Id := N + $; -- GNAT
    Name_Component_Size                 : constant Name_Id := N + $;
    Name_Compose                        : constant Name_Id := N + $;
    Name_Constrained                    : constant Name_Id := N + $;
@@ -1188,6 +1189,7 @@ package Snames is
       Attribute_Callable,
       Attribute_Caller,
       Attribute_Code_Address,
+      Attribute_Compiler_Version,
       Attribute_Component_Size,
       Attribute_Compose,
       Attribute_Constrained,