[multiple changes]

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Is_Standard_String_Type): New function.
	* exp_ch3.adb (Build_Array_Init_Proc): Use
	Is_Standard_String_Type.
	(Expand_Freeze_Array_Type): ditto.
	(Get_Simple_Init_Val): ditto.
	(Needs_Simple_Initialization): ditto.
	* sem_eval.adb (Eval_String_Literal): Use Is_Standard_String_Type.
	* sem_warn.adb (Is_Suspicious_Type): Use Is_Standard_String_Type.

2014-08-04  Pascal Obry  <obry@adacore.com>

	* adaint.c (__gnat_try_lock): Use _tcscpy and _tcscat instead of
	_stprintf which insert garbage into the wfull_path buffer.

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* cal.c: Remove old VMS/nucleus code. Remove obsolete vxworks
	code.
	* fe.h: Minor reformatting.

2014-08-04  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>

	* cstreams.c: (_LARGEFILE_SOURCE): Guard definition.

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* par-ch13.adb (Get_Aspect_Specifications): Improve error
	recovery, fixing a -gnatQ bomb.

From-SVN: r213586

gcc/ada/ChangeLog

+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads, einfo.adb (Is_Standard_String_Type): New function.
+	* exp_ch3.adb (Build_Array_Init_Proc): Use
+	Is_Standard_String_Type.
+	(Expand_Freeze_Array_Type): ditto.
+	(Get_Simple_Init_Val): ditto.
+	(Needs_Simple_Initialization): ditto.
+	* sem_eval.adb (Eval_String_Literal): Use Is_Standard_String_Type.
+	* sem_warn.adb (Is_Suspicious_Type): Use Is_Standard_String_Type.
+
+2014-08-04  Pascal Obry  <obry@adacore.com>
+
+	* adaint.c (__gnat_try_lock): Use _tcscpy and _tcscat instead of
+	_stprintf which insert garbage into the wfull_path buffer.
+
+2014-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+	* cal.c: Remove old VMS/nucleus code. Remove obsolete vxworks
+	code.
+	* fe.h: Minor reformatting.
+
+2014-08-04  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
+
+	* cstreams.c: (_LARGEFILE_SOURCE): Guard definition.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch13.adb (Get_Aspect_Specifications): Improve error
+	recovery, fixing a -gnatQ bomb.
+
 2014-08-04  Yannick Moy  <moy@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration): In GNATprove mode,

gcc/ada/adaint.c

@@ -459,7 +459,20 @@ __gnat_try_lock (char *dir, char *file)
   S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
   S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
 
+  /* ??? the code below crash on MingW64 for obscure reasons, a ticket
+     has been opened here:
+
+     https://sourceforge.net/p/mingw-w64/bugs/414/
+
+     As a workaround an equivalent set of code has been put in place below.
+
   _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
+  */
+
+  _tcscpy (wfull_path, wdir);
+  _tcscat (wfull_path, L"\\");
+  _tcscat (wfull_path, wfile);
+
   fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
 #else
   char full_path[256];

gcc/ada/cal.c

@@ -35,22 +35,6 @@
 /*  struct timeval fields type are not normalized (they are generally       */
 /*  defined as int or long values).                                         */
 
-#if defined(VMS) || defined(__nucleus__)
-
-/* this is temporary code to avoid build failure under VMS */
-
-void
-__gnat_timeval_to_duration (void *t, long *sec, long *usec)
-{
-}
-
-void
-__gnat_duration_to_timeval (long sec, long usec, void *t)
-{
-}
-
-#else
-
 #if defined (__vxworks)
 #ifdef __RTP__
 #include <time.h>
@@ -90,20 +74,3 @@ __gnat_duration_to_timeval (long sec, long usec, struct timeval *t)
   t->tv_sec = sec;
   t->tv_usec = usec;
 }
-#endif
-
-#ifdef __alpha_vxworks
-#include "vxWorks.h"
-#elif defined (__vxworks)
-#include <types/vxTypesOld.h>
-#endif
-
-/* Return the value of the "time" C library function.  We always return
-   a long and do it this way to avoid problems with not knowing
-   what time_t is on the target.  */
-
-long
-gnat_time (void)
-{
-  return time (0);
-}

gcc/ada/cstreams.c

@@ -31,7 +31,9 @@
 
 /* Routines required for implementing routines in Interfaces.C.Streams.  */
 
+#ifndef _LARGEFILE_SOURCE
 #define _LARGEFILE_SOURCE
+#endif
 #define _FILE_OFFSET_BITS 64
 /* the define above will make off_t a 64bit type on GNU/Linux */
 

gcc/ada/einfo.adb

@@ -7264,6 +7264,29 @@ package body Einfo is
       end if;
    end Is_Standard_Character_Type;
 
+   -----------------------------
+   -- Is_Standard_String_Type --
+   -----------------------------
+
+   function Is_Standard_String_Type (Id : E) return B is
+   begin
+      if Is_Type (Id) then
+         declare
+            R : constant Entity_Id := Root_Type (Id);
+         begin
+            return
+              R = Standard_String
+                or else
+              R = Standard_Wide_String
+                or else
+              R = Standard_Wide_Wide_String;
+         end;
+
+      else
+         return False;
+      end if;
+   end Is_Standard_String_Type;
+
    --------------------
    -- Is_String_Type --
    --------------------

gcc/ada/einfo.ads

@@ -2940,9 +2940,14 @@ package Einfo is
 
 --    Is_Standard_Character_Type (synthesized)
 --       Applies to all entities, true for types and subtypes whose root type
---       is one of the standard character types (Character, Wide_Character,
+--       is one of the standard character types (Character, Wide_Character, or
 --       Wide_Wide_Character).
 
+--    Is_Standard_String_Type (synthesized)
+--       Applies to all entities, true for types and subtypes whose root
+--       type is one of the standard string types (String, Wide_String, or
+--       Wide_Wide_String).
+
 --    Is_Statically_Allocated (Flag28)
 --       Defined in all entities. This can only be set for exception,
 --       variable, constant, and type/subtype entities. If the flag is set,
@@ -5233,6 +5238,7 @@ package Einfo is
    --    Has_Foreign_Convention              (synth)
    --    Is_Dynamic_Scope                    (synth)
    --    Is_Standard_Character_Type          (synth)
+   --    Is_Standard_String_Type             (synth)
    --    Underlying_Type                     (synth)
    --    all classification attributes       (synth)
 
@@ -7002,6 +7008,7 @@ package Einfo is
    function Is_Protected_Interface              (Id : E) return B;
    function Is_Protected_Record_Type            (Id : E) return B;
    function Is_Standard_Character_Type          (Id : E) return B;
+   function Is_Standard_String_Type             (Id : E) return B;
    function Is_String_Type                      (Id : E) return B;
    function Is_Synchronized_Interface           (Id : E) return B;
    function Is_Task_Interface                   (Id : E) return B;

gcc/ada/exp_ch3.adb

@@ -713,9 +713,7 @@ package body Exp_Ch3 is
       if Has_Default_Init
         or else (not Restriction_Active (No_Initialize_Scalars)
                   and then Is_Public (A_Type)
-                  and then Root_Type (A_Type) /= Standard_String
-                  and then Root_Type (A_Type) /= Standard_Wide_String
-                  and then Root_Type (A_Type) /= Standard_Wide_Wide_String)
+                  and then not Is_Standard_String_Type (A_Type))
       then
          Proc_Id :=
            Make_Defining_Identifier (Loc,
@@ -6257,10 +6255,7 @@ package body Exp_Ch3 is
             --  initialize scalars mode, and these types are treated specially
             --  and do not need initialization procedures.
 
-            elsif     Root_Type (Base) = Standard_String
-              or else Root_Type (Base) = Standard_Wide_String
-              or else Root_Type (Base) = Standard_Wide_Wide_String
-            then
+            elsif Is_Standard_String_Type (Base) then
                null;
 
             --  Otherwise we have to build an init proc for the subtype
@@ -8001,12 +7996,7 @@ package body Exp_Ch3 is
 
       --  String or Wide_[Wide]_String (must have Initialize_Scalars set)
 
-      elsif Root_Type (T) = Standard_String
-              or else
-            Root_Type (T) = Standard_Wide_String
-              or else
-            Root_Type (T) = Standard_Wide_Wide_String
-      then
+      elsif Is_Standard_String_Type (T) then
          pragma Assert (Init_Or_Norm_Scalars);
 
          return
@@ -9714,10 +9704,7 @@ package body Exp_Ch3 is
       --  filled with appropriate initializing values before they are used).
 
       elsif Consider_IS_NS
-        and then
-          (Root_Type (T) = Standard_String      or else
-           Root_Type (T) = Standard_Wide_String or else
-           Root_Type (T) = Standard_Wide_Wide_String)
+        and then Is_Standard_String_Type (T)
         and then
           (not Is_Itype (T)
             or else Nkind (Associated_Node_For_Itype (T)) /= N_Aggregate)

gcc/ada/fe.h

@@ -174,7 +174,7 @@ extern Boolean In_Same_Source_Unit              (Node_Id, Node_Id);
 #define Exception_Mechanism            opt__exception_mechanism
 #define Float_Format                   opt__float_format
 #define Generate_SCO_Instance_Table    opt__generate_sco_instance_table
-#define GNAT_Mode		       opt__gnat_mode
+#define GNAT_Mode                      opt__gnat_mode
 #define List_Representation_Info       opt__list_representation_info
 
 typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;

gcc/ada/par-ch13.adb

@@ -154,6 +154,9 @@ package body Ch13 is
       Aspects : List_Id;
       OK      : Boolean;
 
+      Opt : Boolean;
+      --  True if current aspect takes an optional argument
+
    begin
       Aspects := Empty_List;
 
@@ -248,6 +251,9 @@ package body Ch13 is
 
          else
             Scan; -- past identifier
+            Opt := Aspect_Argument (A_Id) = Optional_Expression
+                      or else
+                   Aspect_Argument (A_Id) = Optional_Name;
 
             --  Check for 'Class present
 
@@ -285,23 +291,21 @@ package body Ch13 is
             --  definitions are not considered.
 
             if Token = Tok_Comma or else Token = Tok_Semicolon then
-               if Aspect_Argument (A_Id) /= Optional_Expression
-                 and then Aspect_Argument (A_Id) /= Optional_Name
-               then
+               if not Opt then
                   Error_Msg_Node_1 := Identifier (Aspect);
                   Error_Msg_AP ("aspect& requires an aspect definition");
                   OK := False;
                end if;
 
-            --  Check for a missing arrow when the aspect has a definition
+            --  Here we do not have a comma or a semicolon, we are done if we
+            --  do not have an arrow and the aspect does not need an argument
 
-            elsif not Semicolon and then Token /= Tok_Arrow then
-               if Aspect_Argument (A_Id) /= Optional_Expression
-                 and then Aspect_Argument (A_Id) /= Optional_Name
-               then
-                  T_Arrow;
-                  Resync_To_Semicolon;
-               end if;
+            elsif Opt and then Token /= Tok_Arrow then
+               null;
+
+            --  Here we have either an arrow, or an aspect that definitely
+            --  needs an aspect definition, and we will look for one even if
+            --  no arrow is preseant.
 
             --  Otherwise we have an aspect definition
 

gcc/ada/sem_eval.adb

@@ -3661,16 +3661,11 @@ package body Sem_Eval is
       --  Test for illegal Ada 95 cases. A string literal is illegal in Ada 95
       --  if its bounds are outside the index base type and this index type is
       --  static. This can happen in only two ways. Either the string literal
-      --  is too long, or it is null, and the lower bound is type'First. In
-      --  either case it is the upper bound that is out of range of the index
-      --  type.
+      --  is too long, or it is null, and the lower bound is type'First. Either
+      --  way it is the upper bound that is out of range of the index type.
+
       if Ada_Version >= Ada_95 then
-         if Root_Type (Bas) = Standard_String
-              or else
-            Root_Type (Bas) = Standard_Wide_String
-              or else
-            Root_Type (Bas) = Standard_Wide_Wide_String
-         then
+         if Is_Standard_String_Type (Bas) then
             Xtp := Standard_Positive;
          else
             Xtp := Etype (First_Index (Bas));

gcc/ada/sem_warn.adb

@@ -3650,11 +3650,7 @@ package body Sem_Warn is
          if Is_Array_Type (Typ)
            and then not Is_Constrained (Typ)
            and then Number_Dimensions (Typ) = 1
-           and then (Root_Type (Typ) = Standard_String
-                       or else
-                     Root_Type (Typ) = Standard_Wide_String
-                       or else
-                     Root_Type (Typ) = Standard_Wide_Wide_String)
+           and then Is_Standard_String_Type (Typ)
            and then not Has_Warnings_Off (Typ)
          then
             LB := Type_Low_Bound (Etype (First_Index (Typ)));