[multiple changes]

2010-10-25  Robert Dewar  <dewar@adacore.com>

	* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through
	non-static predicate, since we agree not to allow this.
	(Expand_Predicated_Loop): Properlay handle false predicate (null
	list in Static_Predicate field.
	* sem_ch13.adb (Build_Static_Predicate): Extensive changes to clean up
	handling of more general predicate forms.

2010-10-25  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb, sem_util.adb: Minor reformatting.
	* sem_ch8.adb (Find_Selected_Component): Allow selection from instance
	of type in predicate or invariant expression.

2010-10-25  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_stat_to_attr): Can set the timestamp on Windows now.
	(f2t): New routine.
	(__gnat_stat): Rewrite Win32 version.

From-SVN: r165919

gcc/ada/ChangeLog

 2010-10-25  Robert Dewar  <dewar@adacore.com>
 
+	* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through
+	non-static predicate, since we agree not to allow this.
+	(Expand_Predicated_Loop): Properlay handle false predicate (null
+	list in Static_Predicate field.
+	* sem_ch13.adb (Build_Static_Predicate): Extensive changes to clean up
+	handling of more general predicate forms.
+
+2010-10-25  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch4.adb, sem_util.adb: Minor reformatting.
+	* sem_ch8.adb (Find_Selected_Component): Allow selection from instance
+	of type in predicate or invariant expression.
+
+2010-10-25  Pascal Obry  <obry@adacore.com>
+
+	* adaint.c (__gnat_stat_to_attr): Can set the timestamp on Windows now.
+	(f2t): New routine.
+	(__gnat_stat): Rewrite Win32 version.
+
+2010-10-25  Robert Dewar  <dewar@adacore.com>
+
 	* sem_warn.adb, einfo.ads, exp_ch4.adb: Minor comment fix
 	* sem_case.adb: Comment clarification for loops through false
 	predicates.

gcc/ada/adaint.c

@@ -1112,8 +1112,6 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
   attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
 #endif
 
-#if !defined (_WIN32) || defined (RTX)
-  /* on Windows requires extra system call, see __gnat_file_time_name_attr */
   if (ret != 0) {
      attr->timestamp = (OS_Time)-1;
   } else {
@@ -1124,8 +1122,6 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
      attr->timestamp = (OS_Time)statbuf.st_mtime;
 #endif
   }
-#endif
-
 }
 
 /****************************************************************
@@ -1345,6 +1341,19 @@ win32_filetime (HANDLE h)
     return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
   return (time_t) 0;
 }
+
+/* As above but starting from a FILETIME.  */
+static void f2t (const FILETIME *ft, time_t *t)
+{
+  union
+  {
+    FILETIME ft_time;
+    unsigned long long ull_time;
+  } t_write;
+
+  t_write.ft_time = *ft;
+  *t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
+}
 #endif
 
 /* Return a GNAT time stamp given a file name.  */
@@ -1687,15 +1696,10 @@ int
 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
 {
 #ifdef __MINGW32__
-  /* Under Windows the directory name for the stat function must not be
-     terminated by a directory separator except if just after a drive name
-     or with UNC path without directory (only the name of the shared
-     resource), for example: \\computer\share\  */
-
+  WIN32_FILE_ATTRIBUTE_DATA fad;
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-  int name_len, k;
-  TCHAR last_char;
-  int dirsep_count = 0;
+  int name_len;
+  BOOL res;
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
   name_len = _tcslen (wname);
@@ -1703,29 +1707,43 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
   if (name_len > GNAT_MAX_PATH_LEN)
     return -1;
 
-  last_char = wname[name_len - 1];
-
-  while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
-    {
-      wname[name_len - 1] = _T('\0');
-      name_len--;
-      last_char = wname[name_len - 1];
+  ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
+
+  res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
+
+  if (res == FALSE)
+    switch (GetLastError()) {
+    case ERROR_ACCESS_DENIED:
+    case ERROR_SHARING_VIOLATION:
+    case ERROR_LOCK_VIOLATION:
+    case ERROR_SHARING_BUFFER_EXCEEDED:
+      return EACCES;
+    case ERROR_BUFFER_OVERFLOW:
+      return ENAMETOOLONG;
+    case ERROR_NOT_ENOUGH_MEMORY:
+      return ENOMEM;
+    default:
+      return ENOENT;
     }
 
-  /* Count back-slashes.  */
+  f2t (&fad.ftCreationTime, &statbuf->st_ctime);
+  f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
+  f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
+
+  statbuf->st_size = (off_t)fad.nFileSizeLow;
 
-  for (k=0; k<name_len; k++)
-    if (wname[k] == _T('\\') || wname[k] == _T('/'))
-      dirsep_count++;
+  /* We do not have the S_IEXEC attribute, but this is not used on GNAT.  */
+  statbuf->st_mode = S_IREAD;
 
-  /* Only a drive letter followed by ':', we must add a directory separator
-     for the stat routine to work properly.  */
-  if ((name_len == 2 && wname[1] == _T(':'))
-      || (name_len > 3 && wname[0] == _T('\\') && wname[1] == _T('\\')
-	  && dirsep_count == 3))
-    _tcscat (wname, _T("\\"));
+  if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
+    statbuf->st_mode |= S_IFDIR;
+  else
+    statbuf->st_mode |= S_IFREG;
 
-  return _tstat (wname, (struct _stat *)statbuf);
+  if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
+    statbuf->st_mode |= S_IWRITE;
+
+  return 0;
 
 #else
   return GNAT_STAT (name, statbuf);

gcc/ada/exp_ch5.adb

@@ -3001,7 +3001,7 @@ package body Exp_Ch5 is
       if No (Isc) then
          null;
 
-      --  Case of for loop (Loop_Parameter_Specfication present)
+      --  Case of for loop (Loop_Parameter_Specification present)
 
       --  Note: we do not have to worry about validity checking of the for loop
       --  range bounds here, since they were frozen with constant declarations
@@ -3215,26 +3215,20 @@ package body Exp_Ch5 is
       Stmts   : constant List_Id    := Statements (N);
 
    begin
-      --  Case of iteration over non-static predicate. In this case we
-      --  generate the sequence:
-
-      --     for J in Ltype'First .. Ltype'Last loop
-      --        if Ltype_Predicate_Function (J) then
-      --           body;
-      --        end if;
-      --     end loop;
+      --  Case of iteration over non-static predicate, should not be possible
+      --  since this is not allowed by the semantics and should have been
+      --  caught during analysis of the loop statement.
 
       if No (Stat) then
+         raise Program_Error;
 
-         --  The analyzer already expanded the First/Last, so all we have
-         --  to do is wrap the body within the predicate function test.
+      --  If the predicate list is empty, that corresponds to a predicate of
+      --  False, in which case the loop won't run at all, and we rewrite the
+      --  entire loop as a null statement.
 
-         Set_Statements (N, New_List (
-           Make_If_Statement (Loc,
-             Condition =>
-               Make_Predicate_Call (Ltype, New_Occurrence_Of (Loop_Id, Loc)),
-             Then_Statements => Stmts)));
-         Analyze (First (Statements (N)));
+      elsif Is_Empty_List (Stat) then
+         Rewrite (N, Make_Null_Statement (Loc));
+         Analyze (N);
 
       --  For expansion over a static predicate we generate the following
 

gcc/ada/sem_ch4.adb

@@ -2440,9 +2440,8 @@ package body Sem_Ch4 is
             end loop;
          end if;
 
-      --  If not a range, it can be a subtype mark, or else it is
-      --  a degenerate membership test with a singleton value, i.e.
-      --  a test for equality.
+      --  If not a range, it can be a subtype mark, or else it is a degenerate
+      --  membership test with a singleton value, i.e. a test for equality.
 
       else
          Analyze (R);
@@ -2469,8 +2468,8 @@ package body Sem_Ch4 is
             return;
 
          else
-            --  in previous version of the language this is an error
-            --  that will be diagnosed below.
+            --  In previous version of the language this is an error that will
+            --  be diagnosed below.
 
             Find_Type (R);
          end if;

gcc/ada/sem_ch8.adb

@@ -5479,6 +5479,11 @@ package body Sem_Ch8 is
 
             Analyze_Selected_Component (N);
 
+         --  Reference to type name in predicate/invariant expression
+
+         elsif OK_To_Reference (Etype (P)) then
+            Analyze_Selected_Component (N);
+
          elsif Is_Appropriate_For_Entry_Prefix (P_Type)
            and then not In_Open_Scopes (P_Name)
            and then (not Is_Concurrent_Type (Etype (P_Name))
@@ -5490,10 +5495,10 @@ package body Sem_Ch8 is
             Analyze_Selected_Component (N);
 
          elsif (In_Open_Scopes (P_Name)
-                  and then Ekind (P_Name) /= E_Void
-                  and then not Is_Overloadable (P_Name))
+                 and then Ekind (P_Name) /= E_Void
+                 and then not Is_Overloadable (P_Name))
            or else (Is_Concurrent_Type (Etype (P_Name))
-                      and then In_Open_Scopes (Etype (P_Name)))
+                     and then In_Open_Scopes (Etype (P_Name)))
          then
             --  Prefix denotes an enclosing loop, block, or task, i.e. an
             --  enclosing construct that is not a subprogram or accept.
@@ -5508,8 +5513,7 @@ package body Sem_Ch8 is
             --  The subprogram may be a renaming (of an enclosing scope) as
             --  in the case of the name of the generic within an instantiation.
 
-            if (Ekind (P_Name) = E_Procedure
-                 or else Ekind (P_Name) = E_Function)
+            if Ekind_In (P_Name, E_Procedure, E_Function)
               and then Present (Alias (P_Name))
               and then Is_Generic_Instance (Alias (P_Name))
             then

gcc/ada/sem_util.adb

@@ -1226,7 +1226,7 @@ package body Sem_Util is
          return;
       end if;
 
-      --  Ada 2012 AI04-0144-2 : dangerous order dependence. Actuals in nested
+      --  Ada 2012 AI04-0144-2: Dangerous order dependence. Actuals in nested
       --  calls within a construct have been collected. If one of them is
       --  writable and overlaps with another one, evaluation of the enclosing
       --  construct is nondeterministic. This is illegal in Ada 2012, but is
@@ -1278,6 +1278,7 @@ package body Sem_Util is
 
    procedure Check_Potentially_Blocking_Operation (N : Node_Id) is
       S : Entity_Id;
+
    begin
       --  N is one of the potentially blocking operations listed in 9.5.1(8).
       --  When pragma Detect_Blocking is active, the run time will raise
@@ -1294,7 +1295,6 @@ package body Sem_Util is
          if Is_Protected_Type (S) then
             Error_Msg_N
               ("potentially blocking operation in protected operation?", N);
-
             return;
          end if;