[multiple changes]

2014-07-16  Vincent Celier  <celier@adacore.com>

	* gnatls.adb (Normalize): New function.
	(Gnatls): Get the target parameters. On targets other than VMS,
	normalize the path names in the source search path, the object search
	path and the project search path.

2014-07-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb: Avoid self-checking of case expressions in
	dynamic predicates.

2014-07-16  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document effect of Suppress_Initialization on tags and
	discriminants.

From-SVN: r212658

4 files changed, 70 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8c42df4..e63452a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2014-07-16  Vincent Celier  <celier@adacore.com>
+
+	* gnatls.adb (Normalize): New function.
+	(Gnatls): Get the target parameters. On targets other than VMS,
+	normalize the path names in the source search path, the object search
+	path and the project search path.
+
+2014-07-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_case.adb: Avoid self-checking of case expressions in
+	dynamic predicates.
+
+2014-07-16  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Document effect of Suppress_Initialization on tags and
+	discriminants.
+
 2014-07-16  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* switch-b.adb (Scan_Binder_Switches): Add missing guard.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 0781698..ee3abf6 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6945,6 +6945,12 @@ to apply to the base type and all its subtypes. If the pragma is given
 for other than a first subtype, then it applies only to the given subtype.
 The pragma may not be given after the type is frozen.
 
+Note that this includes eliminating initialization of discriminants
+for discriminated types, and tags for tagged types. In these cases,
+you will have to use some non-portable mechanism (e.g. address
+overlays or unchecked conversion) to achieve required initialization
+of these fields before accessing any object of the corresponding type.
+
 @node Pragma Task_Name
 @unnumberedsec Pragma Task_Name
 @findex Task_Name
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
index 4a97edd..c474b92 100644
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -40,7 +40,9 @@ with Prj.Env;     use Prj.Env;
 with Rident;      use Rident;
 with Sdefault;
 with Snames;
+with Stringt;
 with Switch;      use Switch;
+with Targparm;    use Targparm;
 with Types;       use Types;
 
 with GNAT.Case_Util; use GNAT.Case_Util;
@@ -182,6 +184,11 @@ procedure Gnatls is
    function Image (Restriction : Restriction_Id) return String;
    --  Returns the capitalized image of Restriction
 
+   function Normalize (Path : String) return String;
+   --  Returns a normalized path name, except on VMS where the argument Path
+   --  is returned, to keep the host pathname syntax. On Windows, the directory
+   --  separators are set to '\' in Normalize_Pathname.
+
    ------------------------------------------
    -- GNATDIST specific output subprograms --
    ------------------------------------------
@@ -820,6 +827,19 @@ procedure Gnatls is
       return Result;
    end Image;
 
+   ---------------
+   -- Normalize --
+   ---------------
+
+   function Normalize (Path : String) return String is
+   begin
+      if OpenVMS_On_Target then
+         return Path;
+      else
+         return Normalize_Pathname (Path);
+      end if;
+   end Normalize;
+
    --------------------------------
    -- Output_License_Information --
    --------------------------------
@@ -1553,11 +1573,15 @@ begin
 
    Csets.Initialize;
    Snames.Initialize;
+   Stringt.Initialize;
 
    --  First check for --version or --help
 
    Check_Version_And_Help ("GNATLS", "1992");
 
+   Osint.Add_Default_Search_Dirs;
+   Get_Target_Parameters;
+
    --  Loop to scan out arguments
 
    Next_Arg := 1;
@@ -1618,8 +1642,10 @@ begin
          if Dir_In_Src_Search_Path (J)'Length = 0 then
             Write_Str ("<Current_Directory>");
          else
-            Write_Str (To_Host_Dir_Spec
-              (Dir_In_Src_Search_Path (J).all, True).all);
+            Write_Str
+              (Normalize
+                 (To_Host_Dir_Spec
+                    (Dir_In_Src_Search_Path (J).all, True).all));
          end if;
 
          Write_Eol;
@@ -1636,8 +1662,10 @@ begin
          if Dir_In_Obj_Search_Path (J)'Length = 0 then
             Write_Str ("<Current_Directory>");
          else
-            Write_Str (To_Host_Dir_Spec
-              (Dir_In_Obj_Search_Path (J).all, True).all);
+            Write_Str
+              (Normalize
+                 (To_Host_Dir_Spec
+                    (Dir_In_Obj_Search_Path (J).all, True).all));
          end if;
 
          Write_Eol;
@@ -1687,7 +1715,7 @@ begin
 
                   Write_Str ("   ");
                   Write_Str
-                    (Normalize_Pathname
+                    (Normalize
                       (To_Host_Dir_Spec
                         (Project_Path (First .. Last), True).all));
                   Write_Eol;
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index b3f47a6..3a2f815 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2014, 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- --
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
@@ -645,9 +646,6 @@ package body Sem_Case is
 
       Bounds_Hi     : constant Node_Id := Type_High_Bound (Bounds_Type);
       Bounds_Lo     : constant Node_Id := Type_Low_Bound  (Bounds_Type);
-      Has_Predicate : constant Boolean :=
-                        Is_Static_Subtype (Bounds_Type)
-                          and then Present (Static_Predicate (Bounds_Type));
       Num_Choices   : constant Nat     := Choice_Table'Last;
 
       Choice      : Node_Id;
@@ -681,11 +679,17 @@ package body Sem_Case is
 
       Sorting.Sort (Positive (Choice_Table'Last));
 
-      --  The type covered by the list of choices is actually a static subtype
-      --  subject to a static predicate. The predicate defines subsets of legal
-      --  values and requires finer grained analysis.
-
-      if Has_Predicate then
+      --  If the type covered by the list of choices is actually a static
+      --  subtype subject to a static predicate, then the predicate defines
+      --  subsets of legal values and we must verify that the branches of the
+      --  case match those subsets. If there is no static_predicate there is no
+      --  compiler check to perform. In particular we don't want any checks on
+      --  a case expression that itself appears as the expression of a dynamic
+      --  predicate. A case expression that defines a static predicate is
+      --  expanded earlier into a membership test and is not subject to this
+      --  spurious self-check either.
+
+      if Has_Aspect (Bounds_Type, Aspect_Static_Predicate) then
          Pred    := First (Static_Predicate (Bounds_Type));
          Prev_Lo := Uint_Minus_1;
          Prev_Hi := Uint_Minus_1;