]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2014-07-17 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 17 Jul 2014 06:12:09 +0000 (06:12 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 17 Jul 2014 06:12:09 +0000 (06:12 +0000)
* exp_ch7.adb, exp_ch7.ads, sinfo.ads: Minor reformatting.

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

* sem_case.adb (Check_Choice_Set): If the case expression is the
expression in a predicate, do not recheck coverage against itself,
to prevent spurious errors.
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Indicate that
expression comes from an aspect specification, to prevent spurious
errors when expression is a case expression in a predicate.

2014-07-17  Pascal Obry  <obry@adacore.com>

* adaint.c, adaint.h (__gnat_set_executable): Add mode parameter.
* s-os_lib.ads, s-os_lib.adb (Set_Executable): Add Mode parameter.

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

* gnatchop.adb, make.adb, gnatbind.adb, clean.adb, gprep.adb,
gnatxref.adb, gnatls.adb, gnatfind.adb, gnatname.adb: Do not output
the usage for an erroneous invocation of a gnat tool.

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

19 files changed:
gcc/ada/ChangeLog
gcc/ada/adaint.c
gcc/ada/adaint.h
gcc/ada/clean.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_ch7.ads
gcc/ada/gnatbind.adb
gcc/ada/gnatchop.adb
gcc/ada/gnatfind.adb
gcc/ada/gnatls.adb
gcc/ada/gnatname.adb
gcc/ada/gnatxref.adb
gcc/ada/gprep.adb
gcc/ada/make.adb
gcc/ada/s-os_lib.adb
gcc/ada/s-os_lib.ads
gcc/ada/sem_case.adb
gcc/ada/sem_ch13.adb
gcc/ada/sinfo.ads

index 778550e602a884c0aaea1be5dc685cb1e7325361..e00a808e19fbeba2dac0c2cabf5565278b40e979 100644 (file)
@@ -1,3 +1,27 @@
+2014-07-17  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch7.adb, exp_ch7.ads, sinfo.ads: Minor reformatting.
+
+2014-07-17  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_case.adb (Check_Choice_Set): If the case expression is the
+       expression in a predicate, do not recheck coverage against itself,
+       to prevent spurious errors.
+       * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Indicate that
+       expression comes from an aspect specification, to prevent spurious
+       errors when expression is a case expression in a predicate.
+
+2014-07-17  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c, adaint.h (__gnat_set_executable): Add mode parameter.
+       * s-os_lib.ads, s-os_lib.adb (Set_Executable): Add Mode parameter.
+
+2014-07-17  Vincent Celier  <celier@adacore.com>
+
+       * gnatchop.adb, make.adb, gnatbind.adb, clean.adb, gprep.adb,
+       gnatxref.adb, gnatls.adb, gnatfind.adb, gnatname.adb: Do not output
+       the usage for an erroneous invocation of a gnat tool.
+
 2014-07-16  Vincent Celier  <celier@adacore.com>
 
        * gnatls.adb: Get the target parameters only if -nostdinc was
index b1d31b79a96ff4873c6a996a2d51a3ee50cb41cf..151f2e60b8752f27d840cc8842e48c5995b073e8 100644 (file)
@@ -2332,8 +2332,13 @@ __gnat_set_writable (char *name)
 #endif
 }
 
+/* must match definition in s-os_lib.ads */
+#define S_OWNER  1
+#define S_GROUP  2
+#define S_OTHERS 4
+
 void
-__gnat_set_executable (char *name)
+__gnat_set_executable (char *name, int mode)
 {
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
@@ -2349,7 +2354,12 @@ __gnat_set_executable (char *name)
 
   if (GNAT_STAT (name, &statbuf) == 0)
     {
-      statbuf.st_mode = statbuf.st_mode | S_IXUSR;
+      if (mode & S_OWNER)
+        statbuf.st_mode = statbuf.st_mode | S_IXUSR;
+      if (mode & S_GROUP)
+        statbuf.st_mode = statbuf.st_mode | S_IXGRP;
+      if (mode & S_OTHERS)
+        statbuf.st_mode = statbuf.st_mode | S_IXOTH;
       chmod (name, statbuf.st_mode);
     }
 #endif
index 28d4c8c2e2f22164b34b6ec95f28924a13ce2cb9..3c3e4760c70fb89fdf798c929c89dd4fa84c2010 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          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- *
@@ -183,7 +183,7 @@ extern int    __gnat_is_symbolic_link_attr   (char *, struct file_attributes *);
 
 extern void   __gnat_set_non_writable              (char *name);
 extern void   __gnat_set_writable                  (char *name);
-extern void   __gnat_set_executable                (char *name);
+extern void   __gnat_set_executable                (char *name, int);
 extern void   __gnat_set_readable                  (char *name);
 extern void   __gnat_set_non_readable              (char *name);
 extern int    __gnat_is_symbolic_link             (char *name);
index 49e3a5bdd140da57bdc293475f91c2156186577e..dd216cd571887d8d6f0ba9528fc9babf275fbc14 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-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- --
@@ -1460,11 +1460,16 @@ package body Clean is
          end;
       end if;
 
-      --  If neither a project file nor an executable were specified, output
-      --  the usage and exit.
+      --  If neither a project file nor an executable were specified, exit
+      --  displaying the usage if there were no arguments on the command line.
 
       if Main_Project = No_Project and then Osint.Number_Of_Files = 0 then
-         Usage;
+         if Argument_Count = 0 then
+            Usage;
+         else
+            Put_Line ("type ""gnatclean --help"" for help");
+         end if;
+
          return;
       end if;
 
index bee169d32ad47d59e8f0363f46b13e956fefbd8f..060329411939a5ec3d76c1bf46d69a59c0f32514 100644 (file)
@@ -3721,8 +3721,7 @@ package body Exp_Ch7 is
 
          End_Lab := End_Label (HSS);
          Block :=
-           Make_Block_Statement (Loc,
-             Handled_Statement_Sequence => HSS);
+           Make_Block_Statement (Loc, Handled_Statement_Sequence => HSS);
 
          --  Signal the finalization machinery that this particular block
          --  contains the original context.
@@ -7890,8 +7889,8 @@ package body Exp_Ch7 is
 
    begin
       if Present (SE.Actions_To_Be_Wrapped_After) then
-         Insert_List_Before_And_Analyze (
-          First (SE.Actions_To_Be_Wrapped_After), L);
+         Insert_List_Before_And_Analyze
+           (First (SE.Actions_To_Be_Wrapped_After), L);
 
       else
          SE.Actions_To_Be_Wrapped_After := L;
@@ -7915,8 +7914,8 @@ package body Exp_Ch7 is
 
    begin
       if Present (SE.Actions_To_Be_Wrapped_Before) then
-         Insert_List_After_And_Analyze (
-           Last (SE.Actions_To_Be_Wrapped_Before), L);
+         Insert_List_After_And_Analyze
+           (Last (SE.Actions_To_Be_Wrapped_Before), L);
 
       else
          SE.Actions_To_Be_Wrapped_Before := L;
index 6055ce0d42f919848a15a728b72b2a7aa54d6ee4..ba141cbe3f8ec1405f406b064f92126380ffb413 100644 (file)
@@ -295,11 +295,12 @@ package Exp_Ch7 is
 
    procedure Store_Before_Actions_In_Scope (L : List_Id);
    --  Append the list L of actions to the end of the before-actions store in
-   --  the top of the scope stack.
+   --  the top of the scope stack (also analyzes these actions).
 
    procedure Store_After_Actions_In_Scope (L : List_Id);
    --  Prepend the list L of actions to the beginning of the after-actions
-   --  store in the top of the scope stack.
+   --  stored in the top of the scope stack (also analyzes these actions).
+   --  Why prepend rather than append ???
 
    procedure Wrap_Transient_Declaration (N : Node_Id);
    --  N is an object declaration. Expand the finalization calls after the
index 0903fe414ca2a2460da4b021f0db0af602604956..527fc4cae9d0bcf7adf2967cad9eb0e4285d926b 100644 (file)
@@ -666,10 +666,15 @@ begin
       Display_Version ("GNATBIND", "1995");
    end if;
 
-   --  Output usage information if no files
+   --  Output usage information if no arguments
 
    if not More_Lib_Files then
-      Bindusg.Display;
+      if Argument_Count = 0 then
+         Bindusg.Display;
+      else
+         Write_Line ("type ""gnatbind --help"" for help");
+      end if;
+
       Exit_Program (E_Fatal);
    end if;
 
index 82b944b78c572c23a5d730c9f75da05996620c27..6017c563af106a9aea143a4584609fb134270952 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-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- --
@@ -1248,7 +1248,12 @@ procedure Gnatchop is
       --  At least one filename must be given
 
       elsif File.Last = 0 then
-         Usage;
+         if Argument_Count = 0 then
+            Usage;
+         else
+            Put_Line ("type ""gnatchop --help"" for help");
+         end if;
+
          return False;
 
       --  No directory given, set directory to null, so that we can just
index a98e013f2f86a0606b1be53396d00d4d750ab53f..a09df21a9282b3cfc75349a32ff2855467c668c5 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-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- --
@@ -30,6 +30,7 @@ with Types;    use Types;
 with Xr_Tabls; use Xr_Tabls;
 with Xref_Lib; use Xref_Lib;
 
+with Ada.Command_Line;  use Ada.Command_Line;
 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 with Ada.Text_IO;       use Ada.Text_IO;
 
@@ -227,7 +228,8 @@ procedure Gnatfind is
                end if;
 
             when others =>
-               Write_Usage;
+               Put_Line ("type ""gnatfind --help"" for help");
+               raise Usage_Error;
          end case;
       end loop;
 
@@ -266,16 +268,19 @@ procedure Gnatfind is
       when GNAT.Command_Line.Invalid_Switch =>
          Ada.Text_IO.Put_Line ("Invalid switch : "
                                & GNAT.Command_Line.Full_Switch);
-         Write_Usage;
+         Put_Line ("type ""gnatfind --help"" for help");
+         raise Usage_Error;
 
       when GNAT.Command_Line.Invalid_Parameter =>
          Ada.Text_IO.Put_Line ("Parameter missing for : "
                                & GNAT.Command_Line.Full_Switch);
-         Write_Usage;
+         Put_Line ("type ""gnatfind --help"" for help");
+         raise Usage_Error;
 
       when Xref_Lib.Invalid_Argument =>
          Ada.Text_IO.Put_Line ("Invalid line or column in the pattern");
-         Write_Usage;
+         Put_Line ("type ""gnatfind --help"" for help");
+         raise Usage_Error;
    end Parse_Cmd_Line;
 
    -----------
@@ -344,7 +349,12 @@ begin
    Parse_Cmd_Line;
 
    if not Have_Entity then
-      Write_Usage;
+      if Argument_Count = 0 then
+         Write_Usage;
+      else
+         Put_Line ("type ""gnatfind --help"" for help");
+         raise Usage_Error;
+      end if;
    end if;
 
    --  Special case to speed things up: if the user has a command line of the
@@ -372,7 +382,8 @@ begin
       Ada.Text_IO.Put_Line ("Error: for type hierarchy output you must "
                             & "specify only one file.");
       Ada.Text_IO.New_Line;
-      Write_Usage;
+      Put_Line ("type ""gnatfind --help"" for help");
+      raise Usage_Error;
    end if;
 
    Search (Pattern, Local_Symbols, Wide_Search, Read_Only,
index 33f7682b651d31bc5abfe267599f5184862fbbc8..4df2503bde081d476ecf98fdaf6fd16f510b31bc 100644 (file)
@@ -45,6 +45,8 @@ with Switch;      use Switch;
 with Targparm;    use Targparm;
 with Types;       use Types;
 
+with Ada.Command_Line; use Ada.Command_Line;
+
 with GNAT.Case_Util; use GNAT.Case_Util;
 
 procedure Gnatls is
@@ -1599,7 +1601,7 @@ begin
       Set_Standard_Error;
       Write_Str ("Can't use -l with another switch");
       Write_Eol;
-      Usage;
+      Write_Line ("type ""gnatls --help"" for help");
       Exit_Program (E_Fatal);
    end if;
 
@@ -1748,7 +1750,11 @@ begin
 
    if not More_Lib_Files then
       if not Print_Usage and then not Verbose_Mode then
-         Usage;
+         if Argument_Count = 0 then
+            Usage;
+         else
+            Write_Line ("type ""gnatls --help"" for help");
+         end if;
       end if;
 
       Exit_Program (E_Fatal);
index 56157ead462eddfff733c759374ed8280fc2ee48..efc842780c3532c1865d8c99edf84736b0e071ce 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -289,7 +289,7 @@ procedure Gnatname is
                       Patterns.Last
                         (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
                   then
-                     Usage;
+                     Put_Line ("type ""gnatname --help"" for help");
                      return;
                   end if;
 
@@ -619,7 +619,12 @@ begin
       and then
       Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
    then
-      Usage;
+      if Argument_Count = 0 then
+         Usage;
+      else
+         Put_Line ("type ""gnatname --help"" for help");
+      end if;
+
       return;
    end if;
 
index cbdf54a6d942b9e60c21b382c005e80936efcc8b..2912b4f5db1815307ce795a15c61172ce6ec2869 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-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- --
@@ -30,6 +30,7 @@ with Switch;   use Switch;
 with Xr_Tabls; use Xr_Tabls;
 with Xref_Lib; use Xref_Lib;
 
+with Ada.Command_Line;  use Ada.Command_Line;
 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 with Ada.Text_IO;       use Ada.Text_IO;
 
@@ -209,7 +210,8 @@ procedure Gnatxref is
                end if;
 
             when others =>
-               Write_Usage;
+               Put_Line ("type ""gnatxref --help"" for help");
+               raise Usage_Error;
          end case;
       end loop;
 
@@ -225,7 +227,8 @@ procedure Gnatxref is
             if Ada.Strings.Fixed.Index (S, ":") /= 0 then
                Ada.Text_IO.Put_Line
                  ("Only file names are allowed on the command line");
-               Write_Usage;
+               Put_Line ("type ""gnatxref --help"" for help");
+               raise Usage_Error;
             end if;
 
             Add_Xref_File (S);
@@ -237,12 +240,14 @@ procedure Gnatxref is
       when GNAT.Command_Line.Invalid_Switch =>
          Ada.Text_IO.Put_Line ("Invalid switch : "
                                & GNAT.Command_Line.Full_Switch);
-         Write_Usage;
+         Put_Line ("type ""gnatxref --help"" for help");
+         raise Usage_Error;
 
       when GNAT.Command_Line.Invalid_Parameter =>
          Ada.Text_IO.Put_Line ("Parameter missing for : "
                                & GNAT.Command_Line.Full_Switch);
-         Write_Usage;
+         Put_Line ("type ""gnatxref --help"" for help");
+         raise Usage_Error;
    end Parse_Cmd_Line;
 
    -----------
@@ -296,7 +301,12 @@ begin
    Parse_Cmd_Line;
 
    if not Have_File then
-      Write_Usage;
+      if Argument_Count = 0 then
+         Write_Usage;
+      else
+         Put_Line ("type ""gnatxref --help"" for help");
+         raise Usage_Error;
+      end if;
    end if;
 
    Xr_Tabls.Set_Default_Match (True);
index 54d2c8e92e84af08b008e8dba85d4079a5a0d051..63286cad1fc856ca5cfd91c8d5a825bbc5c3c2fb 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-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- --
@@ -38,7 +38,8 @@ with Stringt;  use Stringt;
 with Switch;   use Switch;
 with Types;    use Types;
 
-with Ada.Text_IO;     use Ada.Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Text_IO;      use Ada.Text_IO;
 
 with GNAT.Case_Util;            use GNAT.Case_Util;
 with GNAT.Command_Line;
@@ -205,14 +206,19 @@ package body GPrep is
 
          --  No input file specified, just output the usage and exit
 
-         Usage;
+         if Argument_Count = 0 then
+            Usage;
+         else
+            Put_Line ("type ""gnatprep --help"" for help");
+         end if;
+
          return;
 
       elsif Outfile_Name = No_Name then
 
-         --  No output file specified, just output the usage and exit
+         --  No output file specified, exit
 
-         Usage;
+         Put_Line ("type ""gnatprep --help"" for help");
          return;
       end if;
 
@@ -767,7 +773,7 @@ package body GPrep is
             when GNAT.Command_Line.Invalid_Switch =>
                Write_Str ("Invalid Switch: -");
                Write_Line (GNAT.Command_Line.Full_Switch);
-               Usage;
+               Put_Line ("type ""gnatprep --help"" for help");
                OS_Exit (1);
          end;
       end loop;
index ebd2bfd9a522506e6b19d98cde1dca9c7b6afa52..15b6330142910614a393b44b46b1df3d7472d15b 100644 (file)
@@ -5856,9 +5856,14 @@ package body Make is
 
             Targparm.Get_Target_Parameters;
 
-            --  Output usage information if no files to compile
+            --  Output usage information if no argument on the command line
+
+            if Argument_Count = 0 then
+               Usage;
+            else
+               Write_Line ("type ""gnatmake --help"" for help");
+            end if;
 
-            Usage;
             Finish_Program (Project_Tree, E_Success);
          end if;
       end if;
index f20e0cf5673506aae2517c5845b8a751826d409f..6669b42f0cc5a2a3a704c2da4e141f11bd66b490 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1995-2013, AdaCore                     --
+--                     Copyright (C) 1995-2014, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -2375,14 +2375,14 @@ package body System.OS_Lib is
    -- Set_Executable --
    --------------------
 
-   procedure Set_Executable (Name : String) is
-      procedure C_Set_Executable (Name : C_File_Name);
+   procedure Set_Executable (Name : String; Mode : Positive := S_Owner) is
+      procedure C_Set_Executable (Name : C_File_Name; Mode : Integer);
       pragma Import (C, C_Set_Executable, "__gnat_set_executable");
       C_Name : aliased String (Name'First .. Name'Last + 1);
    begin
       C_Name (Name'Range)  := Name;
       C_Name (C_Name'Last) := ASCII.NUL;
-      C_Set_Executable (C_Name (C_Name'First)'Address);
+      C_Set_Executable (C_Name (C_Name'First)'Address, Mode);
    end Set_Executable;
 
    ----------------------
index 616c8523fc8e828150f5cc593d524c874f5ed1f5..41989d9c202ab9de3f14602f984507163508bc33 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1995-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-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- --
@@ -522,6 +522,10 @@ package System.OS_Lib is
    --  contains the name of the file to which it is linked. Symbolic links may
    --  span file systems and may refer to directories.
 
+   S_Owner  : constant := 1;
+   S_Group  : constant := 2;
+   S_Others : constant := 4;
+
    procedure Set_Writable (Name : String);
    --  Change permissions on the named file to make it writable for its owner
 
@@ -533,7 +537,7 @@ package System.OS_Lib is
    --  This renaming is provided for backwards compatibility with previous
    --  versions. The use of Set_Non_Writable is preferred (clearer name).
 
-   procedure Set_Executable (Name : String);
+   procedure Set_Executable (Name : String; Mode : Positive := S_Owner);
    --  Change permissions on the named file to make it executable for its owner
 
    procedure Set_Readable (Name : String);
index 30e79b258347768a3f239d0369e064995cb8e383..fc7dc44ef96e36fd19c9ac19f41a0c7bc7f3fea2 100644 (file)
@@ -662,6 +662,15 @@ package body Sem_Case is
    --  Start of processing for Check_Choice_Set
 
    begin
+      --  If the case is part of a predicate aspect specification, do not
+      --  recheck it against itself.
+
+      if Present (Parent (Case_Node))
+        and then Nkind (Parent (Case_Node)) = N_Aspect_Specification
+      then
+         return;
+      end if;
+
       --  Choice_Table must start at 0 which is an unused location used by the
       --  sorting algorithm. However the first valid position for a discrete
       --  choice is 1.
index a8f04731b939b0159501259619f11ee4ffae9297..7245306a343d710dfe2a7547fa24921c16ca48bc 100644 (file)
@@ -8033,6 +8033,11 @@ package body Sem_Ch13 is
       --  All other cases
 
       else
+         --  Indicate that the expression comes from an aspect specification,
+         --  which is used in subsequent analysis even if expansion is off.
+
+         Set_Parent (End_Decl_Expr, ASN);
+
          --  In a generic context the aspect expressions have not been
          --  preanalyzed, so do it now. There are no conformance checks
          --  to perform in this case.
@@ -8052,6 +8057,7 @@ package body Sem_Ch13 is
             and then Is_Private_Type (T)
          then
             Preanalyze_Spec_Expression (End_Decl_Expr, Full_View (T));
+
          else
             Preanalyze_Spec_Expression (End_Decl_Expr, T);
          end if;
@@ -8059,11 +8065,12 @@ package body Sem_Ch13 is
          Err := not Fully_Conformant_Expressions (End_Decl_Expr, Freeze_Expr);
       end if;
 
-      --  Output error message if error
+      --  Output error message if error. Force error on aspect specification
+      --  even if there is an error on the expression itself.
 
       if Err then
          Error_Msg_NE
-           ("visibility of aspect for& changes after freeze point",
+           ("!visibility of aspect for& changes after freeze point",
             ASN, Ent);
          Error_Msg_NE
            ("info: & is frozen here, aspects evaluated at this point??",
index 3bae44d1a319a11f4aed87629f0d1d99c2e03cd8..be0e6498dd75c28cd1b0256a21b3e5732f0fc8c8 100644 (file)
@@ -492,10 +492,10 @@ package Sinfo is
    --  technical reasons it is impossible or very hard to have the original
    --  structure properly decorated by semantic information, and the rewritten
    --  structure fully reproduces the original source. Below is the (incomplete
-   --  for the moment) list of such exceptions:
+   --  for the moment???) list of such exceptions:
    --
-   --  * generic specifications and generic bodies;
-   --  * function calls that use prefixed notation (Operand.Operation [(...)]);
+   --    Generic specifications and generic bodies
+   --    Function calls that use prefixed notation (Operand.Operation [(...)])
 
    --  Representation Information