2013-10-10 Thomas Quinot <quinot@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 10 Oct 2013 12:30:10 +0000 (12:30 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 10 Oct 2013 12:30:10 +0000 (12:30 +0000)
* s-oscons-tmplt.c, s-taprop-posix.adb (CLOCK_REALTIME): Always define,
possibly using a dummy placeholder value.
(Compute_Deadline): For the case of an
Absolute_Calendar deadline, if the target uses another clock
than CLOCK_REALTIME as CLOCK_RT_Ada, compensate for possible
different epoch.

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

* sem_ch8.adb (Find_Expanded_Name): Handle properly a fully
qualified reference to a generic child unit within itself,
in an instantiation.

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

gcc/ada/ChangeLog
gcc/ada/s-oscons-tmplt.c
gcc/ada/s-taprop-posix.adb
gcc/ada/sem_ch8.adb

index ddec47a..8936328 100644 (file)
@@ -1,3 +1,18 @@
+2013-10-10  Thomas Quinot  <quinot@adacore.com>
+
+       * s-oscons-tmplt.c, s-taprop-posix.adb (CLOCK_REALTIME): Always define,
+       possibly using a dummy placeholder value.
+       (Compute_Deadline): For the case of an
+       Absolute_Calendar deadline, if the target uses another clock
+       than CLOCK_REALTIME as CLOCK_RT_Ada, compensate for possible
+       different epoch.
+
+2013-10-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch8.adb (Find_Expanded_Name): Handle properly a fully
+       qualified reference to a generic child unit within itself,
+       in an instantiation.
+
 2013-10-10  Pascal Obry  <obry@adacore.com>
 
        * prj-conf.adb: Minor typo fixes in comment.
index d3b0ef4..7a6d9eb 100644 (file)
@@ -1389,13 +1389,10 @@ CST(Inet_Pton_Linkname, "")
 
 /* Note: On HP-UX, CLOCK_REALTIME is an enum, not a macro. */
 
-#if defined(CLOCK_REALTIME) || defined (__hpux__)
-# define HAVE_CLOCK_REALTIME
+#if !(defined (__hpux__) || defined (CLOCK_REALTIME))
+# define CLOCK_REALTIME -1
 #endif
-
-#ifdef HAVE_CLOCK_REALTIME
 CND(CLOCK_REALTIME, "System realtime clock")
-#endif
 
 #ifdef CLOCK_MONOTONIC
 CND(CLOCK_MONOTONIC, "System monotonic clock")
index 275828d..cf45eb4 100644 (file)
@@ -262,6 +262,8 @@ package body System.Task_Primitives.Operations is
    begin
       Check_Time := Monotonic_Clock;
 
+      --  Relative deadline
+
       if Mode = Relative then
          Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
 
@@ -269,12 +271,40 @@ package body System.Task_Primitives.Operations is
             Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
          end if;
 
-      else
+         pragma Warnings (Off);
+         --  Must comment a pragma Warnings (Off) to say why ???
+
+      --  Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
+
+      elsif Mode = Absolute_RT
+              or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
+      then
+         pragma Warnings (On);
          Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
 
          if Relative_Timed_Wait then
             Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
          end if;
+
+      --  Absolute deadline specified using the real-time clock, in the
+      --  case where it is not the same as the tasking clock: compensate for
+      --  difference between clock epochs (Base_Time - Base_Cal_Time).
+
+      else
+         declare
+            Cal_Check_Time : constant Duration :=
+                               OS_Primitives.Monotonic_Clock;
+            RT_Time        : constant Duration :=
+                               Time + Check_Time - Cal_Check_Time;
+         begin
+            Abs_Time :=
+              Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
+
+            if Relative_Timed_Wait then
+               Rel_Time :=
+                 Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
+            end if;
+         end;
       end if;
    end Compute_Deadline;
 
index 1e6470b..ee2749f 100644 (file)
@@ -5157,12 +5157,10 @@ package body Sem_Ch8 is
       Selector  : constant Node_Id := Selector_Name (N);
       Candidate : Entity_Id        := Empty;
       P_Name    : Entity_Id;
-      O_Name    : Entity_Id;
       Id        : Entity_Id;
 
    begin
       P_Name := Entity (Prefix (N));
-      O_Name := P_Name;
 
       --  If the prefix is a renamed package, look for the entity in the
       --  original package.
@@ -5340,15 +5338,22 @@ package body Sem_Ch8 is
             else
                --  Within the instantiation of a child unit, the prefix may
                --  denote the parent instance, but the selector has the name
-               --  of the original child. Find whether we are within the
-               --  corresponding instance, and get the proper entity, which
-               --  can only be an enclosing scope.
-
-               if O_Name /= P_Name
-                 and then In_Open_Scopes (P_Name)
+               --  of the original child. That is to say, when A.B appears
+               --  within an instantiation of generic child unit B, the scope
+               --  stack includes an instance of A (P_Name) and an instance
+               --  of B under some other name. We scan the scope to find this
+               --  child instance, which is the desired entity.
+               --  Note that the parent may itself be a child instance, if
+               --  the reference is of the form A.B.C, in which case A.B has
+               --  already been rewritten with the proper entity.
+
+               if In_Open_Scopes (P_Name)
                  and then Is_Generic_Instance (P_Name)
                then
                   declare
+                     Gen_Par : constant Entity_Id :=
+                                 Generic_Parent (Specification
+                                   (Unit_Declaration_Node (P_Name)));
                      S : Entity_Id := Current_Scope;
                      P : Entity_Id;
 
@@ -5365,9 +5370,12 @@ package body Sem_Ch8 is
                            P := Generic_Parent (Specification
                                   (Unit_Declaration_Node (S)));
 
+                           --  Check that P is a generic child of the generic
+                           --  parent of the prefix.
+
                            if Present (P)
-                             and then Chars (Scope (P)) = Chars (O_Name)
                              and then Chars (P) = Chars (Selector)
+                             and then Scope (P) = Gen_Par
                            then
                               Id := S;
                               goto Found;