Skip to content

R
riscv-gcc-1
Commit d2d8b2a7 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r212716
parent 3fad4d00
Showing with 169 additions and 57 deletions
gcc/ada/ChangeLog
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
......
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
......
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);
......
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;
......
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;
......
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
......
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;
......
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
......
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,
......
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);
......
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;
......
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);
......
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;
......
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;
......
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;
----------------------
......
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);
......
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.
......
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??",
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment