2014-10-10 Yannick Moy <moy@adacore.com>

	* sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global
	contracts.
	* errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless
	SPARK_Mode is Off.

2014-10-10  Vadim Godunko  <godunko@adacore.com>

	* a-stwima.adb (To_Sequence): Compute size of result array.

2014-10-10  Javier Miranda  <miranda@adacore.com>

	* gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the
	sources of the example to avoid a warning when the Ada files are
	automatically generated by the binding generator.

2014-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Resolve_Attribute, case 'Update): Set
	Do_Range_Check on the expression of a record component
	association when needed, as is done for array components, when
	the corresponding type is a scalar type.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@216084 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 79 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b62069f464b..401751c6e99 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2014-10-10  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Analyze_Global_Item): Accept formal objects in Global
+	contracts.
+	* errout.adb, errout.ads (SPARK_Msg_NE): Issue error unless
+	SPARK_Mode is Off.
+
+2014-10-10  Vadim Godunko  <godunko@adacore.com>
+
+	* a-stwima.adb (To_Sequence): Compute size of result array.
+
+2014-10-10  Javier Miranda  <miranda@adacore.com>
+
+	* gnat_ugn.texi (Interfacing with C++ at the Class Level): Update the
+	sources of the example to avoid a warning when the Ada files are
+	automatically generated by the binding generator.
+
+2014-10-10  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Resolve_Attribute, case 'Update): Set
+	Do_Range_Check on the expression of a record component
+	association when needed, as is done for array components, when
+	the corresponding type is a scalar type.
+
 2014-10-10  Gary Dismukes  <dismukes@adacore.com>
 
 	* a-coinho-shared.adb: Minor typo fix.
diff --git a/gcc/ada/a-stwima.adb b/gcc/ada/a-stwima.adb
index 5937c7d9ec9..c7ab14f4ac4 100644
--- a/gcc/ada/a-stwima.adb
+++ b/gcc/ada/a-stwima.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -567,20 +567,25 @@ package body Ada.Strings.Wide_Maps is
    function To_Sequence
      (Set : Wide_Character_Set) return Wide_Character_Sequence
    is
-      SS : constant Wide_Character_Ranges_Access := Set.Set;
-
-      Result : Wide_String (Positive range 1 .. 2 ** 16);
-      N      : Natural := 0;
+      SS    : constant Wide_Character_Ranges_Access := Set.Set;
+      N     : Natural := 0;
+      Count : Natural := 0;
 
    begin
       for J in SS'Range loop
-         for K in SS (J).Low .. SS (J).High loop
-            N := N + 1;
-            Result (N) := K;
-         end loop;
+         Count :=
+           Count + (Wide_Character'Pos (SS (J).High) -
+                    Wide_Character'Pos (SS (J).Low) + 1);
       end loop;
 
-      return Result (1 .. N);
+      return Result : Wide_String (1 .. Count) do
+         for J in SS'Range loop
+            for K in SS (J).Low .. SS (J).High loop
+               N := N + 1;
+               Result (N) := K;
+            end loop;
+         end loop;
+      end return;
    end To_Sequence;
 
    ------------
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 78ca1fe2fc4..f26059adbc3 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -3153,7 +3153,7 @@ package body Errout is
       E   : Node_Or_Entity_Id)
    is
    begin
-      if SPARK_Mode = On then
+      if SPARK_Mode /= Off then
          Error_Msg_NE (Msg, N, E);
       end if;
    end SPARK_Msg_NE;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 92642daacd4..abde9b435ac 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -876,9 +876,8 @@ package Errout is
       N   : Node_Or_Entity_Id;
       E   : Node_Or_Entity_Id);
    pragma Inline (SPARK_Msg_NE);
-   --  Same as Error_Msg_NE, but the error is reported only when SPARK_Mode is
-   --  "on". The routine is inlined because it acts as a simple wrapper.
-   --  Is it right that this is so different from SPARK_Msg_N???
+   --  Same as Error_Msg_NE, but the error is suppressed if SPARK_Mode is Off.
+   --  The routine is inlined because it acts as a simple wrapper.
 
    ------------------------------------
    -- Utility Interface for Back End --
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index e58a2a90a61..2c6aabd2ff8 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -2960,14 +2960,15 @@ constructors are defined on the C++ side and imported from the Ada
 side, and latter the reverse case.
 
 The root of our derivation will be the @code{Animal} class, with a
-single private attribute (the @code{Age} of the animal) and two public
-primitives to set and get the value of this attribute.
+single private attribute (the @code{Age} of the animal), a constructor,
+and two public primitives to set and get the value of this attribute.
 
 @smallexample
 @b{class} Animal @{
  @b{public}:
    @b{virtual} void Set_Age (int New_Age);
    @b{virtual} int Age ();
+   Animal() @{Age_Count = 0;@};
  @b{private}:
    int Age_Count;
 @};
@@ -3013,19 +3014,19 @@ how to import these C++ declarations from the Ada side:
 @smallexample @c ada
 @b{with} Interfaces.C.Strings; @b{use} Interfaces.C.Strings;
 @b{package} Animals @b{is}
-  @b{type} Carnivore @b{is} interface;
+  @b{type} Carnivore @b{is} @b{limited} interface;
   @b{pragma} Convention (C_Plus_Plus, Carnivore);
   @b{function} Number_Of_Teeth (X : Carnivore)
      @b{return} Natural @b{is} @b{abstract};
 
-  @b{type} Domestic @b{is} interface;
-  @b{pragma} Convention (C_Plus_Plus, Set_Owner);
+  @b{type} Domestic @b{is} @b{limited} interface;
+  @b{pragma} Convention (C_Plus_Plus, Domestic);
   @b{procedure} Set_Owner
     (X    : @b{in} @b{out} Domestic;
      Name : Chars_Ptr) @b{is} @b{abstract};
 
-  @b{type} Animal @b{is} @b{tagged} @b{record}
-    Age : Natural := 0;
+  @b{type} Animal @b{is} @b{tagged} @b{limited} @b{record}
+    Age : Natural;
   @b{end} @b{record};
   @b{pragma} Import (C_Plus_Plus, Animal);
 
@@ -3035,13 +3036,17 @@ how to import these C++ declarations from the Ada side:
   @b{function} Age (X : Animal) @b{return} Integer;
   @b{pragma} Import (C_Plus_Plus, Age);
 
+  @b{function} New_Animal @b{return} Animal;
+  @b{pragma} CPP_Constructor (New_Animal);
+  @b{pragma} Import (CPP, New_Animal, "_ZN6AnimalC1Ev");
+
   @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record}
     Tooth_Count : Natural;
     Owner       : String (1 .. 30);
   @b{end} @b{record};
   @b{pragma} Import (C_Plus_Plus, Dog);
 
-  @b{function} Number_Of_Teeth (A : Dog) @b{return} Integer;
+  @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural;
   @b{pragma} Import (C_Plus_Plus, Number_Of_Teeth);
 
   @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr);
@@ -3100,19 +3105,19 @@ them to C++, using the same hierarchy of our previous example:
 @b{with} Interfaces.C.Strings;
 @b{use} Interfaces.C.Strings;
 @b{package} Animals @b{is}
-  @b{type} Carnivore @b{is} interface;
+  @b{type} Carnivore @b{is} @b{limited} interface;
   @b{pragma} Convention (C_Plus_Plus, Carnivore);
   @b{function} Number_Of_Teeth (X : Carnivore)
      @b{return} Natural @b{is} @b{abstract};
 
-  @b{type} Domestic @b{is} interface;
-  @b{pragma} Convention (C_Plus_Plus, Set_Owner);
+  @b{type} Domestic @b{is} @b{limited} interface;
+  @b{pragma} Convention (C_Plus_Plus, Domestic);
   @b{procedure} Set_Owner
     (X    : @b{in} @b{out} Domestic;
      Name : Chars_Ptr) @b{is} @b{abstract};
 
   @b{type} Animal @b{is} @b{tagged} @b{record}
-    Age : Natural := 0;
+    Age : Natural;
   @b{end} @b{record};
   @b{pragma} Convention (C_Plus_Plus, Animal);
 
@@ -3122,13 +3127,16 @@ them to C++, using the same hierarchy of our previous example:
   @b{function} Age (X : Animal) @b{return} Integer;
   @b{pragma} Export (C_Plus_Plus, Age);
 
+  @b{function} New_Animal @b{return} Animal'Class;
+  @b{pragma} Export (C_Plus_Plus, New_Animal);
+
   @b{type} Dog @b{is} @b{new} Animal @b{and} Carnivore @b{and} Domestic @b{with} @b{record}
     Tooth_Count : Natural;
     Owner       : String (1 .. 30);
   @b{end} @b{record};
   @b{pragma} Convention (C_Plus_Plus, Dog);
 
-  @b{function} Number_Of_Teeth (A : Dog) @b{return} Integer;
+  @b{function} Number_Of_Teeth (A : Dog) @b{return} Natural;
   @b{pragma} Export (C_Plus_Plus, Number_Of_Teeth);
 
   @b{procedure} Set_Owner (A : @b{in} @b{out} Dog; Name : Chars_Ptr);
@@ -3139,7 +3147,8 @@ them to C++, using the same hierarchy of our previous example:
 @b{end} Animals;
 @end smallexample
 
-Compared with our previous example the only difference is the use of
+Compared with our previous example the only differences are the use of
+@code{pragma Convention} (instead of @code{pragma Import}), and the use of
 @code{pragma Export} to indicate to the GNAT compiler that the primitives will
 be available to C++. Thanks to the ABI compatibility, on the C++ side there is
 nothing else to be done; as explained above, the only requirement is that all
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index cdb3cfe33c2..7906041d08b 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11021,13 +11021,21 @@ package body Sem_Attr is
 
                else
                   Assoc := First (Component_Associations (Aggr));
+
                   while Present (Assoc) loop
                      Comp := First (Choices (Assoc));
+                     Expr := Expression (Assoc);
 
                      if Nkind (Comp) /= N_Others_Choice
                        and then not Error_Posted (Comp)
                      then
-                        Resolve (Expression (Assoc), Etype (Entity (Comp)));
+                        Resolve (Expr, Etype (Entity (Comp)));
+
+                        if Is_Scalar_Type (Etype (Entity (Comp)))
+                          and then not Is_OK_Static_Expression (Expr)
+                        then
+                           Set_Do_Range_Check (Expr);
+                        end if;
                      end if;
 
                      Next (Assoc);
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 436b9b12a29..ec0441961df 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1977,6 +1977,11 @@ package body Sem_Prag is
                elsif Ekind (Item_Id) = E_Constant then
                   SPARK_Msg_N ("global item cannot denote a constant", Item);
 
+               --  A formal object may act as a global item inside a generic
+
+               elsif Is_Formal_Object (Item_Id) then
+                  null;
+
                --  The only legal references are those to abstract states and
                --  variables (SPARK RM 6.1.4(4)).