[multiple changes]

2012-05-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Subtypes_Statically_Match): In Ada 2012, static
	matching requires matching of static subtype predicates as well.

2012-05-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb (Analyze_Choices): If the subtype of the
	expression has a non-static predicate, the case alternatives
	must cover the base type.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* a-calend-vms.ads: Add pragma export to Split and Time_Of.
	Merge comments from a-calend.ads to minimize differences.

2012-05-15  Sergey Rybin  <rybin@adacore.com frybin>

	* gnat_ugn.texi: gnatmetric: add a small example that demonstrates
	the difference between control coupling and unit coupling.

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* bindgen.adb (Gen_Header): Remove code to emit LE_Set.
	(Gen_Finalize_Library): Replace test with
	a call to __gnat_reraise_library_exception_if_any.
	* s-soflin.ads (Library_Exception): Do not export.
	(Library_Exception_Set): Likewise.
	* a-except-2005.ads, a-except-2005.adb
	(Reraise_Library_Exception_If_Any): New procedure.

From-SVN: r187509

9 files changed, 233 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 33d66c6..0b9c112 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2012-05-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_eval.adb (Subtypes_Statically_Match): In Ada 2012, static
+	matching requires matching of static subtype predicates as well.
+
+2012-05-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_case.adb (Analyze_Choices): If the subtype of the
+	expression has a non-static predicate, the case alternatives
+	must cover the base type.
+
+2012-05-15  Tristan Gingold  <gingold@adacore.com>
+
+	* a-calend-vms.ads: Add pragma export to Split and Time_Of.
+	Merge comments from a-calend.ads to minimize differences.
+
+2012-05-15  Sergey Rybin  <rybin@adacore.com frybin>
+
+	* gnat_ugn.texi: gnatmetric: add a small example that demonstrates
+	the difference between control coupling and unit coupling.
+
+2012-05-15  Tristan Gingold  <gingold@adacore.com>
+
+	* bindgen.adb (Gen_Header): Remove code to emit LE_Set.
+	(Gen_Finalize_Library): Replace test with
+	a call to __gnat_reraise_library_exception_if_any.
+	* s-soflin.ads (Library_Exception): Do not export.
+	(Library_Exception_Set): Likewise.
+	* a-except-2005.ads, a-except-2005.adb
+	(Reraise_Library_Exception_If_Any): New procedure.
+
 2012-05-15  Geert Bosch  <bosch@adacore.com>
 
 	* sem_ch9.adb (Allows_Lock_Free_Implementation): out or in out
diff --git a/gcc/ada/a-calend-vms.ads b/gcc/ada/a-calend-vms.ads
index d0fdc4a..134882b 100644
--- a/gcc/ada/a-calend-vms.ads
+++ b/gcc/ada/a-calend-vms.ads
@@ -33,28 +33,31 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the Alpha/VMS version
+--  This is the OpenVMS version
 
 with System.OS_Primitives;
 
 package Ada.Calendar is
 
-   package OSP renames System.OS_Primitives;
-
    type Time is private;
 
-   --  Declarations representing limits of allowed local time values. Note
-   --  that these do NOT constrain the possible stored values of time which
-   --  may well permit a larger range of times (this is explicitly allowed
-   --  in Ada 95).
+   --  Declarations representing limits of allowed local time values. Note that
+   --  these do NOT constrain the possible stored values of time which may well
+   --  permit a larger range of times (this is explicitly allowed in Ada 95).
 
    subtype Year_Number  is Integer range 1901 .. 2399;
    subtype Month_Number is Integer range 1 .. 12;
    subtype Day_Number   is Integer range 1 .. 31;
 
+   --  A Day_Duration value of 86_400.0 designates a new day
+
    subtype Day_Duration is Duration range 0.0 .. 86_400.0;
 
    function Clock return Time;
+   --  The returned time value is the number of nanoseconds since the start
+   --  of Ada time (1901-01-01 00:00:00.0 UTC). If leap seconds are enabled,
+   --  the result will contain all elapsed leap seconds since the start of
+   --  Ada time until now.
 
    function Year    (Date : Time) return Year_Number;
    function Month   (Date : Time) return Month_Number;
@@ -67,17 +70,39 @@ package Ada.Calendar is
       Month   : out Month_Number;
       Day     : out Day_Number;
       Seconds : out Day_Duration);
+   --  Break down a time value into its date components set in the current
+   --  time zone. If Split is called on a time value created using Ada 2005
+   --  Time_Of in some arbitrary time zone, the input value will always be
+   --  interpreted as relative to the local time zone.
 
    function Time_Of
      (Year    : Year_Number;
       Month   : Month_Number;
       Day     : Day_Number;
       Seconds : Day_Duration := 0.0) return Time;
+   --  GNAT Note: Normally when procedure Split is called on a Time value
+   --  result of a call to function Time_Of, the out parameters of procedure
+   --  Split are identical to the in parameters of function Time_Of. However,
+   --  when a non-existent time of day is specified, the values for Seconds
+   --  may or may not be different. This may happen when Daylight Saving Time
+   --  (DST) is in effect, on the day when switching to DST, if Seconds
+   --  specifies a time of day in the hour that does not exist. For example,
+   --  in New York:
+   --
+   --    Time_Of (Year => 1998, Month => 4, Day => 5, Seconds => 10740.0)
+   --
+   --  will return a Time value T. If Split is called on T, the resulting
+   --  Seconds may be 14340.0 (3:59:00) instead of 10740.0 (2:59:00 being
+   --  a time that not exist).
 
    function "+" (Left : Time;     Right : Duration) return Time;
    function "+" (Left : Duration; Right : Time)     return Time;
    function "-" (Left : Time;     Right : Duration) return Time;
    function "-" (Left : Time;     Right : Time)     return Duration;
+   --  The first three functions will raise Time_Error if the resulting time
+   --  value is less than the start of Ada time in UTC or greater than the
+   --  end of Ada time in UTC. The last function will raise Time_Error if the
+   --  resulting difference cannot fit into a duration value.
 
    function "<"  (Left, Right : Time) return Boolean;
    function "<=" (Left, Right : Time) return Boolean;
@@ -121,10 +146,11 @@ private
    --  Relative Time is positive, whereas relative OS_Time is negative,
    --  but this declaration makes for easier conversion.
 
-   type Time is new OSP.OS_Time;
+   type Time is new System.OS_Primitives.OS_Time;
 
    Days_In_Month : constant array (Month_Number) of Day_Number :=
                      (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+   --  Days in month for non-leap year, leap year case is adjusted in code
 
    Invalid_Time_Zone_Offset : Long_Integer;
    pragma Import (C, Invalid_Time_Zone_Offset, "__gnat_invalid_tzoff");
@@ -132,8 +158,13 @@ private
    function Is_Leap (Year : Year_Number) return Boolean;
    --  Determine whether a given year is leap
 
-   --  The following packages provide a target independent interface to the
-   --  children of Calendar - Arithmetic, Formatting and Time_Zones.
+   ----------------------------------------------------------
+   -- Target-Independent Interface to Children of Calendar --
+   ----------------------------------------------------------
+
+   --  The following packages provide a target-independent interface to the
+   --  children of Calendar - Arithmetic, Conversions, Delays, Formatting and
+   --  Time_Zones.
 
    --  NOTE: Delays does not need a target independent interface because
    --  VMS already has a target specific file for that package.
@@ -168,6 +199,7 @@ private
    ---------------------------
 
    package Conversion_Operations is
+
       function To_Ada_Time (Unix_Time : Long_Integer) return Time;
       --  Unix to Ada Epoch conversion
 
@@ -231,6 +263,7 @@ private
          Use_TZ      : Boolean;
          Is_Historic : Boolean;
          Time_Zone   : Long_Integer);
+      pragma Export (Ada, Split, "__gnat_split");
       --  Split a time value into its components. If flag Is_Historic is set,
       --  this routine would try to use to the best of the OS's abilities the
       --  time zone offset that was or will be in effect on Date. Set Use_TZ
@@ -251,6 +284,7 @@ private
          Use_TZ       : Boolean;
          Is_Historic  : Boolean;
          Time_Zone    : Long_Integer) return Time;
+      pragma Export (Ada, Time_Of, "__gnat_time_of");
       --  Given all the components of a date, return the corresponding time
       --  value. Set Use_Day_Secs to use the value in Day_Secs, otherwise the
       --  day duration will be calculated from Hour, Minute, Second and Sub_
@@ -269,7 +303,8 @@ private
    package Time_Zones_Operations is
 
       function UTC_Time_Offset (Date : Time) return Long_Integer;
-      --  Return the offset in seconds from UTC
+      --  Return (in seconds) the difference between the local time zone and
+      --  UTC time at a specific historic date.
 
    end Time_Zones_Operations;
 
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 509ea924..9892808 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -1287,6 +1287,19 @@ package body Ada.Exceptions is
       Raise_Current_Excep (Excep.Id);
    end Reraise;
 
+   --------------------------------------
+   -- Reraise_Library_Exception_If_Any --
+   --------------------------------------
+
+   procedure Reraise_Library_Exception_If_Any is
+      LE : Exception_Occurrence;
+   begin
+      if Library_Exception_Set then
+         LE := Library_Exception;
+         Raise_From_Controlled_Operation (LE);
+      end if;
+   end Reraise_Library_Exception_If_Any;
+
    ------------------------
    -- Reraise_Occurrence --
    ------------------------
diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads
index a7dbfd6..3f4b17a 100644
--- a/gcc/ada/a-except-2005.ads
+++ b/gcc/ada/a-except-2005.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -236,6 +236,13 @@ private
    --  Raise Program_Error, providing information about X (an exception raised
    --  during a controlled operation) in the exception message.
 
+   procedure Reraise_Library_Exception_If_Any;
+   pragma Export
+     (Ada, Reraise_Library_Exception_If_Any,
+           "__gnat_reraise_library_exception_if_any");
+   --  If there was an exception raised during library-level finalization,
+   --  reraise the exception.
+
    procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
    pragma No_Return (Reraise_Occurrence_Always);
    --  This differs from Raise_Occurrence only in that the caller guarantees
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index c44a648..686082d 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -1357,19 +1357,6 @@ package body Bindgen is
       procedure Gen_Header is
       begin
          WBI ("   procedure finalize_library is");
-
-         --  The following flag is used to check for library-level exceptions
-         --  raised during finalization. Symbol comes from System.Soft_Links.
-         --  VM targets use regular Ada to reference the entity.
-
-         if VM_Target = No_VM then
-            WBI ("      LE_Set : Boolean;");
-
-            Set_String ("      pragma Import (Ada, LE_Set, ");
-            Set_String ("""__gnat_library_exception_set"");");
-            Write_Statement_Buffer;
-         end if;
-
          WBI ("   begin");
       end Gen_Header;
 
@@ -1569,27 +1556,17 @@ package body Bindgen is
          --  and the routine necessary to raise it.
 
          if VM_Target = No_VM then
-            WBI ("      if LE_Set then");
-            WBI ("         declare");
-            WBI ("            LE : Ada.Exceptions.Exception_Occurrence;");
-
-            Set_String ("            pragma Import (Ada, LE, ");
-            Set_String ("""__gnat_library_exception"");");
-            Write_Statement_Buffer;
-
-            Set_String ("            procedure Raise_From_Controlled_");
-            Set_String ("Operation (X : Ada.Exceptions.Exception_");
-            Set_String ("Occurrence);");
-            Write_Statement_Buffer;
+            WBI ("      declare");
+            WBI ("         procedure Reraise_Library_Exception_If_Any;");
 
-            Set_String ("            pragma Import (Ada, Raise_From_");
-            Set_String ("Controlled_Operation, ");
-            Set_String ("""__gnat_raise_from_controlled_operation"");");
+            Set_String ("            pragma Import (Ada, ");
+            Set_String ("Reraise_Library_Exception_If_Any, ");
+            Set_String ("""__gnat_reraise_library_exception_if_any"");");
             Write_Statement_Buffer;
 
-            WBI ("         begin");
-            WBI ("            Raise_From_Controlled_Operation (LE);");
-            WBI ("         end;");
+            WBI ("      begin");
+            WBI ("         Reraise_Library_Exception_If_Any;");
+            WBI ("      end;");
 
          --  VM-specific code, use regular Ada to produce the desired behavior
 
@@ -1599,9 +1576,10 @@ package body Bindgen is
             Set_String ("         Ada.Exceptions.Reraise_Occurrence (");
             Set_String ("System.Soft_Links.Library_Exception);");
             Write_Statement_Buffer;
+
+            WBI ("      end if;");
          end if;
 
-         WBI ("      end if;");
          WBI ("   end finalize_library;");
          WBI ("");
       end if;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index d5130d9..6adfb207 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14954,14 +14954,88 @@ upon units that define subprograms are counted, so control fan-out coupling
 is reported for all units, but control fan-in coupling - only for the units
 that define subprograms.
 
+The following simple example illustrates the difference between unit coupling
+and control coupling metrics:
 
+@smallexample @c ada
+package Lib_1 is
+    function F_1 (I : Integer) return Integer;
+end Lib_1;
+
+package Lib_2 is
+    type T_2 is new Integer;
+end Lib_2;
+
+package body Lib_1 is
+    function F_1 (I : Integer) return Integer is
+    begin
+       return I + 1;
+    end F_1;
+end Lib_1;
+
+with Lib_2; use Lib_2;
+package Pack is
+    Var : T_2;
+    function Fun (I : Integer) return Integer;
+end Pack;
+
+with Lib_1; use Lib_1;
+package body Pack is
+    function Fun (I : Integer) return Integer is
+    begin
+       return F_1 (I);
+    end Fun;
+end Pack;
+@end smallexample
+
+@noindent
+if we apply @command{gnatmetric} with @code{--coupling-all} option to these
+units, the result will be:
+
+@smallexample
+Coupling metrics:
+=================
+    Unit Lib_1 (C:\customers\662\L406-007\lib_1.ads)
+       control fan-out coupling  : 0
+       control fan-in coupling   : 1
+       unit fan-out coupling     : 0
+       unit fan-in coupling      : 1
+
+    Unit Pack (C:\customers\662\L406-007\pack.ads)
+       control fan-out coupling  : 1
+       control fan-in coupling   : 0
+       unit fan-out coupling     : 2
+       unit fan-in coupling      : 0
+
+    Unit Lib_2 (C:\customers\662\L406-007\lib_2.ads)
+       control fan-out coupling  : 0
+       unit fan-out coupling     : 0
+       unit fan-in coupling      : 1
+@end smallexample
+
+@noindent
+The result does not contain values for object-oriented
+coupling because none of the argument unit contains a tagged type and
+therefore none of these units can be treated as a class.
 
+@code{Pack} (considered as a program unit, that is spec+body) depends on two
+units - @code{Lib_1} @code{and Lib_2}, therefore it has unit fan-out coupling
+equals to 2. And nothing depend on it, so its unit fan-in coupling is 0 as
+well as control fan-in coupling. Only one of the units @code{Pack} depends
+upon defines a subprogram, so its control fan-out coupling is 1.
 
+@code{Lib_2} depends on nothing, so fan-out metrics for it are 0. It does
+not define a subprogram, so control fan-in metric cannot be applied to it,
+and there is one unit that depends on it (@code{Pack}), so it has
+unit fan-in coupling equals to 1.
 
+@code{Lib_1} is similar to @code{Lib_2}, but it does define a subprogram.
+So it has control fan-in coupling equals to 1 (because there is a unit
+depending on it).
 
 When computing coupling metrics, @command{gnatmetric} counts only
-dependencies between units that are arguments of the gnatmetric call.
-Coupling metrics are program-wide (or project-wide) metrics, so to
+dependencies between units that are arguments of the @command{gnatmetric}
+call. Coupling metrics are program-wide (or project-wide) metrics, so to
 get a valid result, you should call @command{gnatmetric} for
 the whole set of sources that make up your program. It can be done
 by calling @command{gnatmetric} from the GNAT driver with @option{-U}
diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads
index f2d858b..701b3bc 100644
--- a/gcc/ada/s-soflin.ads
+++ b/gcc/ada/s-soflin.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -289,12 +289,10 @@ package System.Soft_Links is
    -------------------------------------
 
    Library_Exception : EO;
-   pragma Export (Ada, Library_Exception, "__gnat_library_exception");
    --  Library-level finalization routines use this common reference to store
    --  the first library-level exception which occurs during finalization.
 
    Library_Exception_Set : Boolean := False;
-   pragma Export (Ada, Library_Exception_Set, "__gnat_library_exception_set");
    --  Used in conjunction with Library_Exception, set when an exception has
    --  been stored.
 
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 1825cab..3e37440 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -803,8 +803,18 @@ package body Sem_Case is
          --  bounds of its base type to determine the values covered by the
          --  discrete choices.
 
+         --  In Ada 2012, if the subtype has a non-static predicate the full
+         --  range of the base type must be covered as well.
+
          if Is_OK_Static_Subtype (Subtyp) then
-            Bounds_Type := Subtyp;
+            if not Has_Predicates (Subtyp)
+              or else Present (Static_Predicate (Subtyp))
+            then
+               Bounds_Type := Subtyp;
+            else
+               Bounds_Type := Choice_Type;
+            end if;
+
          else
             Bounds_Type := Choice_Type;
          end if;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 0daeb4c..329a267 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4664,6 +4664,41 @@ package body Sem_Eval is
    --  values match (RM 4.9.1(1)).
 
    function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean is
+
+      function Predicates_Match return Boolean;
+      --  In Ada 2012, subtypes statically match if their static predicates
+      --  match as well.
+
+      function Predicates_Match return Boolean is
+         Pred1 : Node_Id;
+         Pred2 : Node_Id;
+
+      begin
+         if Ada_Version < Ada_2012 then
+            return True;
+
+         elsif Has_Predicates (T1) /= Has_Predicates (T2) then
+            return False;
+
+         else
+            Pred1 := Get_Rep_Item_For_Entity (T1, Name_Static_Predicate);
+            Pred2 := Get_Rep_Item_For_Entity (T2, Name_Static_Predicate);
+
+            --  Subtypes statically match if the predicate comes from the
+            --  same declaration, which can only happen if one is a subtype
+            --  of the other and has no explicit predicate.
+
+            --  Suppress warnings on order of actuals, which is otherwise
+            --  triggered by one of the two calls below.
+
+            pragma Warnings (Off);
+            return Pred1 = Pred2
+              or else (No (Pred1) and then Is_Subtype_Of (T1, T2))
+              or else (No (Pred2) and then Is_Subtype_Of (T2, T1));
+            pragma Warnings (On);
+         end if;
+      end Predicates_Match;
+
    begin
       --  A type always statically matches itself
 
@@ -4736,7 +4771,7 @@ package body Sem_Eval is
             --  If the bounds are the same tree node, then match
 
             if LB1 = LB2 and then HB1 = HB2 then
-               return True;
+               return Predicates_Match;
 
             --  Otherwise bounds must be static and identical value