[multiple changes]

2009-04-16  Jerome Lambourg  <lambourg@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Make sure that pragma pack is not
	taken into account for VM targets.

2009-04-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* g-calend.ads, g-calend.adb (Week_In_Year): Now calls
	Year_Week_In_Year.
	(Year_Week_In_Year): New routine which contains the original code from
	Week_In_Year. Add the missing special case for January 1st falling on
	a Monday.

From-SVN: r146167

4 files changed, 88 insertions, 46 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8f657b5..b9474b8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2009-04-16  Jerome Lambourg  <lambourg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Make sure that pragma pack is not
+	taken into account for VM targets.
+
+2009-04-16  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* g-calend.ads, g-calend.adb (Week_In_Year): Now calls
+	Year_Week_In_Year.
+	(Year_Week_In_Year): New routine which contains the original code from
+	Week_In_Year. Add the missing special case for January 1st falling on
+	a Monday.
+
 2009-04-16  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_dist.adb (Build_From_Any_Call): For a subtype that is a generic
diff --git a/gcc/ada/g-calend.adb b/gcc/ada/g-calend.adb
index 9d3c33d..8ccd433 100644
--- a/gcc/ada/g-calend.adb
+++ b/gcc/ada/g-calend.adb
@@ -293,7 +293,23 @@ package body GNAT.Calendar is
    ------------------
 
    function Week_In_Year (Date : Time) return Week_In_Year_Number is
-      Year       : Year_Number;
+      Year : Year_Number;
+      Week : Week_In_Year_Number;
+      pragma Unreferenced (Year);
+   begin
+      Year_Week_In_Year (Date, Year, Week);
+      return Week;
+   end Week_In_Year;
+
+   -----------------------
+   -- Year_Week_In_Year --
+   -----------------------
+
+   procedure Year_Week_In_Year
+     (Date : Time;
+      Year : out Year_Number;
+      Week : out Week_In_Year_Number)
+   is
       Month      : Month_Number;
       Day        : Day_Number;
       Hour       : Hour_Number;
@@ -381,14 +397,13 @@ package body GNAT.Calendar is
       is
          Last_Jan_1 : constant Day_Name :=
                         Jan_1_Day_Of_Week (Jan_1, Year, Last_Year => True);
+
       begin
          --  These two cases are illustrated in the table below
 
          return
            Last_Jan_1 = Thursday
-             or else
-               (Last_Jan_1 = Wednesday
-                  and then Is_Leap (Year - 1));
+             or else (Last_Jan_1 = Wednesday and then Is_Leap (Year - 1));
       end Last_Year_Has_53_Weeks;
 
    --  Start of processing for Week_In_Year
@@ -437,9 +452,7 @@ package body GNAT.Calendar is
       --  when special casing the first week of January and the last week of
       --  December.
 
-      if Day = 1
-        and then Month = 1
-      then
+      if Day = 1 and then Month = 1 then
          Jan_1 := Day_Of_Week (Date);
       else
          Jan_1 := Day_Of_Week (Time_Of (Year, 1, 1, 0.0));
@@ -461,19 +474,23 @@ package body GNAT.Calendar is
          --    +-----+-----+-----+=====+-----+-----+-----+
 
          if (Day = 1 and then Jan_1 in Friday .. Sunday)
-           or else
+               or else
             (Day = 2 and then Jan_1 in Friday .. Saturday)
-           or else
+               or else
             (Day = 3 and then Jan_1 = Friday)
          then
             if Last_Year_Has_53_Weeks (Jan_1, Year) then
-               return 53;
+               Week := 53;
             else
-               return 52;
+               Week := 52;
             end if;
 
-         --  Special case 2: January 1, 2, 3, 4, 5 and 6 of the first week. In
-         --  this scenario January 1 does not fall on a Monday.
+            --  January 1, 2 and 3 belong to the previous year
+
+            Year := Year - 1;
+            return;
+
+         --  Special case 2: January 1, 2, 3, 4, 5, 6 and 7 of the first week
 
          --    +-----+-----+-----+=====+-----+-----+-----+
          --    | Mon | Tue | Wed # Thu # Fri | Sat | Sun |
@@ -484,14 +501,19 @@ package body GNAT.Calendar is
          --    +-----+-----+-----+-----+-----+-----+-----+
          --    | 31  |  1  |  2  #  3  #  4  |  5  |  6  |
          --    +-----+-----+-----+-----+-----+-----+-----+
+         --    |  1  |  2  |  3  #  4  #  5  |  6  |  7  |
+         --    +-----+-----+-----+=====+-----+-----+-----+
 
-         elsif (Day <= 4 and then Jan_1 in Tuesday .. Thursday)
-           or else
-               (Day = 5  and then Jan_1 in Tuesday .. Wednesday)
-           or else
-               (Day = 6  and then Jan_1 = Tuesday)
+         elsif (Day <= 4 and then Jan_1 in Monday .. Thursday)
+                  or else
+               (Day = 5  and then Jan_1 in Monday .. Wednesday)
+                  or else
+               (Day = 6  and then Jan_1 in Monday ..  Tuesday)
+                  or else
+               (Day = 7  and then Jan_1 = Monday)
          then
-            return 1;
+            Week := 1;
+            return;
          end if;
 
       --  Special case 3: December 29, 30 and 31. These days may belong to
@@ -507,20 +529,20 @@ package body GNAT.Calendar is
       --    | 31  |  1  |  2  #  3  #  4  |  5  |  6  |
       --    +-----+-----+-----+=====+-----+-----+-----+
 
-      elsif Month = 12
-        and then Day > 28
-      then
+      elsif Month = 12 and then Day > 28 then
          declare
             Next_Jan_1 : constant Day_Name :=
                            Jan_1_Day_Of_Week (Jan_1, Year, Next_Year => True);
          begin
             if (Day = 29 and then Next_Jan_1 = Thursday)
-              or else
+                  or else
                (Day = 30 and then Next_Jan_1 in Wednesday .. Thursday)
-              or else
+                  or else
                (Day = 31 and then Next_Jan_1 in Tuesday .. Thursday)
             then
-               return 1;
+               Year := Year + 1;
+               Week := 1;
+               return;
             end if;
          end;
       end if;
@@ -541,7 +563,7 @@ package body GNAT.Calendar is
       --  origin which falls on Monday.
 
       Shift := 7 - Day_Name'Pos (Jan_1);
-      return Start_Week + (Day_In_Year (Date) - Shift - 1) / 7;
-   end Week_In_Year;
+      Week  := Start_Week + (Day_In_Year (Date) - Shift - 1) / 7;
+   end Year_Week_In_Year;
 
 end GNAT.Calendar;
diff --git a/gcc/ada/g-calend.ads b/gcc/ada/g-calend.ads
index 8bb2e6e..39ca203 100644
--- a/gcc/ada/g-calend.ads
+++ b/gcc/ada/g-calend.ads
@@ -70,18 +70,9 @@ package GNAT.Calendar is
    --  Return the day name
 
    function Day_In_Year (Date : Ada.Calendar.Time) return Day_In_Year_Number;
-   --  Returns the day number in the year. (1st January is day 1 and 31st
+   --  Return the day number in the year. (1st January is day 1 and 31st
    --  December is day 365 or 366 for leap year).
 
-   function Week_In_Year (Date : Ada.Calendar.Time) return Week_In_Year_Number;
-   --  Returns the week number as defined in ISO 8601. A week always starts on
-   --  a Monday and the first week of a particular year is the one containing
-   --  the first Thursday. A year may have 53 weeks when January 1st is a
-   --  Wednesday and the year is leap or January 1st is a Thursday. Note that
-   --  the last days of December may belong to the first week on the next year
-   --  and conversely, the first days of January may belong to the last week
-   --  of the last year.
-
    procedure Split
      (Date       : Ada.Calendar.Time;
       Year       : out Ada.Calendar.Year_Number;
@@ -102,7 +93,23 @@ package GNAT.Calendar is
       Minute     : Minute_Number;
       Second     : Second_Number;
       Sub_Second : Second_Duration := 0.0) return Ada.Calendar.Time;
-   --  Returns an Ada.Calendar.Time data built from the date and time values
+   --  Return an Ada.Calendar.Time data built from the date and time values
+
+   function Week_In_Year (Date : Ada.Calendar.Time) return Week_In_Year_Number;
+   --  Return the week number as defined in ISO 8601. A week always starts on
+   --  a Monday and the first week of a particular year is the one containing
+   --  the first Thursday. A year may have 53 weeks when January 1st is a
+   --  Wednesday and the year is leap or January 1st is a Thursday. Note that
+   --  the last days of December may belong to the first week on the next year
+   --  and conversely, the first days of January may belong to the last week
+   --  of the last year.
+
+   procedure Year_Week_In_Year
+     (Date : Ada.Calendar.Time;
+      Year : out Ada.Calendar.Year_Number;
+      Week : out Week_In_Year_Number);
+   --  Return the week number as defined in ISO 8601 along with the year in
+   --  which the week occurs.
 
    --  C timeval conversion
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index e8cd0a0..c3b0f34 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9365,14 +9365,14 @@ package body Sem_Prag is
                else
                   if not Rep_Item_Too_Late (Typ, N) then
                      if VM_Target = No_VM then
-                        Set_Is_Packed (Base_Type (Typ));
+                        Set_Is_Packed            (Base_Type (Typ));
+                        Set_Has_Pragma_Pack      (Base_Type (Typ));
+                        Set_Has_Non_Standard_Rep (Base_Type (Typ));
+
                      elsif not GNAT_Mode then
                         Error_Pragma
                           ("?pragma% ignored in this configuration");
                      end if;
-
-                     Set_Has_Pragma_Pack      (Base_Type (Typ));
-                     Set_Has_Non_Standard_Rep (Base_Type (Typ));
                   end if;
                end if;
 
@@ -9381,13 +9381,13 @@ package body Sem_Prag is
             else pragma Assert (Is_Record_Type (Typ));
                if not Rep_Item_Too_Late (Typ, N) then
                   if VM_Target = No_VM then
-                     Set_Is_Packed (Base_Type (Typ));
+                     Set_Is_Packed            (Base_Type (Typ));
+                     Set_Has_Pragma_Pack      (Base_Type (Typ));
+                     Set_Has_Non_Standard_Rep (Base_Type (Typ));
+
                   elsif not GNAT_Mode then
                      Error_Pragma ("?pragma% ignored in this configuration");
                   end if;
-
-                  Set_Has_Pragma_Pack      (Base_Type (Typ));
-                  Set_Has_Non_Standard_Rep (Base_Type (Typ));
                end if;
             end if;
          end Pack;