diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-17 06:12:09 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-07-17 06:12:09 +0000 |
commit | c1efebf99e1d1fc1f196fbe3b3222ac3cc19c262 (patch) | |
tree | dbf1a3f04bae9a8d171e9ca2a7b1aaec91d67569 /gcc/ada | |
parent | 5005fc53898b92435c6065c2f62a071ac71f2951 (diff) | |
download | gcc-c1efebf99e1d1fc1f196fbe3b3222ac3cc19c262.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212716 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 24 | ||||
-rw-r--r-- | gcc/ada/adaint.c | 14 | ||||
-rw-r--r-- | gcc/ada/adaint.h | 4 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 13 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 11 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.ads | 5 | ||||
-rw-r--r-- | gcc/ada/gnatbind.adb | 9 | ||||
-rw-r--r-- | gcc/ada/gnatchop.adb | 9 | ||||
-rw-r--r-- | gcc/ada/gnatfind.adb | 25 | ||||
-rw-r--r-- | gcc/ada/gnatls.adb | 10 | ||||
-rw-r--r-- | gcc/ada/gnatname.adb | 11 | ||||
-rw-r--r-- | gcc/ada/gnatxref.adb | 22 | ||||
-rw-r--r-- | gcc/ada/gprep.adb | 18 | ||||
-rw-r--r-- | gcc/ada/make.adb | 9 | ||||
-rw-r--r-- | gcc/ada/s-os_lib.adb | 8 | ||||
-rw-r--r-- | gcc/ada/s-os_lib.ads | 8 | ||||
-rw-r--r-- | gcc/ada/sem_case.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 11 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 6 |
19 files changed, 169 insertions, 57 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 778550e602a..e00a808e19f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index b1d31b79a96..151f2e60b87 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -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 diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 28d4c8c2e2f..3c3e4760c70 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -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); diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 49e3a5bdd14..dd216cd5718 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -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; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index bee169d32ad..06032941193 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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; diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 6055ce0d42f..ba141cbe3f8 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -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 diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 0903fe414ca..527fc4cae9d 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -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; diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 82b944b78c5..6017c563af1 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -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 diff --git a/gcc/ada/gnatfind.adb b/gcc/ada/gnatfind.adb index a98e013f2f8..a09df21a928 100644 --- a/gcc/ada/gnatfind.adb +++ b/gcc/ada/gnatfind.adb @@ -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, diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 33f7682b651..4df2503bde0 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -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); diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 56157ead462..efc842780c3 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -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; diff --git a/gcc/ada/gnatxref.adb b/gcc/ada/gnatxref.adb index cbdf54a6d94..2912b4f5db1 100644 --- a/gcc/ada/gnatxref.adb +++ b/gcc/ada/gnatxref.adb @@ -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); diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 54d2c8e92e8..63286cad1fc 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -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; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index ebd2bfd9a52..15b63301429 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index f20e0cf5673..6669b42f0cc 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -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; ---------------------- diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 616c8523fc8..41989d9c202 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -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); diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 30e79b25834..fc7dc44ef96 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -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. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a8f04731b93..7245306a343 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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??", diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 3bae44d1a31..be0e6498dd7 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 |