+2010-09-10 Robert Dewar <dewar@adacore.com>
+
+ * gnat_ugn.texi: Add section on intent of style checking options.
+
+2010-09-10 Arnaud Charlet <charlet@adacore.com>
+
+ * xref_lib.adb (Get_Full_Type): Fix handling of 'a' char.
+
+2010-09-10 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb: Improve error message on derivation from class-wide type
+
+2010-09-10 Steve Baird <baird@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Enable Expression_With_Actions
+ generation when Generate_SCIL is True.
+
+2010-09-10 Geert Bosch <bosch@adacore.com>
+
+ * gnatlink.adb (Check_ Existing_Executable): New procedure for checking
+ validity of executable name and removing any existing executable
+ (Gnatlink): Call Check_Existing_Executable.
+
2010-09-10 Arnaud Charlet <charlet@adacore.com>
* s-tporft.adb, s-taskin.ads (Register_Foreign_Thread): Move
elsif Debug_Flag_Dot_YY then
Use_Expression_With_Actions := False;
- -- If no debug flags, usage off for SCIL
-
- elsif Generate_SCIL then
- Use_Expression_With_Actions := False;
-
-- Otherwise this feature is implemented, so we allow its use
else
the character sequence ``(style)''. This message does not prevent
successful compilation (unless the @option{-gnatwe} switch is used).
+Note that this is by no means intended to be a general facility for
+checking arbitrary coding standards. It is simply an embedding of the
+style rules we have chosen for the GNAT sources. If you are starting
+a project which does not have established style standards, you may
+find it useful to adopt the entire set of GNAT coding standards, or
+some subset of them. If you already have an established set of coding
+standards, then it may be that selected style checking options do
+indeed correspond to choices you have made, but for general checking
+of an existing set of coding rules, you should look to the gnatcheck
+tool, which is designed for that purpose.
+
@ifset vms
@code{(option,option,@dots{})} is a sequence of keywords
@end ifset
function Base_Name (File_Name : String) return String;
-- Return just the file name part without the extension (if present)
+ procedure Check_Existing_Executable (File_Name : String);
+ -- Delete any existing executable to avoid accidentally updating
+ -- the target of a symbolic link, but produce a Fatail_Error if
+ -- File_Name matches any of the source file names. This avoids
+ -- overwriting of extensionless source files by accident on systems
+ -- where executables do not have extensions.
+
procedure Delete (Name : String);
-- Wrapper to unlink as status is ignored by this application
return File_Name (Findex1 .. Findex2 - 1);
end Base_Name;
+ -------------------------------
+ -- Check_Existing_Executable --
+ -------------------------------
+
+ procedure Check_Existing_Executable (File_Name : String) is
+ Ename : String := File_Name;
+ Efile : File_Name_Type;
+ Sfile : File_Name_Type;
+ begin
+ Canonical_Case_File_Name (Ename);
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Ename);
+ Efile := Name_Find;
+
+ for J in Units.Table'First .. Units.Last loop
+ Sfile := Units.Table (J).Sfile;
+ if Sfile = Efile then
+ Exit_With_Error ("executable name """ & File_Name & """ matches "
+ & "source file name """ & Get_Name_String (Sfile) & """");
+ end if;
+ end loop;
+
+ Delete (File_Name);
+ end Check_Existing_Executable;
+
------------
-- Delete --
------------
new String'(Output_File_Name.all);
end if;
- -- Delete existing executable, in case it is a symbolic link, to avoid
- -- modifying the target of the symbolic link.
-
- declare
- Dummy : Boolean;
- pragma Unreferenced (Dummy);
-
- begin
- Delete_File (Output_File_Name.all, Dummy);
- end;
+ Check_Existing_Executable (Output_File_Name.all);
-- Warn if main program is called "test", as that may be a built-in command
-- on Unix. On non-Unix systems executables have a suffix, so the warning
if not Is_Generic_Actual_Type (Parent_Type)
or else In_Visible_Part (Scope (Parent_Type))
then
- Error_Msg_N
- ("type derived from tagged type must have extension", Indic);
+ if Is_Class_Wide_Type (Parent_Type) then
+ Error_Msg_N
+ ("parent type must not be a class-wide type", Indic);
+
+ -- Use specific type to prevent cascaded errors.
+
+ Parent_Type := Etype (Parent_Type);
+
+ else
+ Error_Msg_N
+ ("type derived from tagged type must have extension", Indic);
+ end if;
end if;
end if;
when 'T' => return "task type";
when 'W' => return "protected type";
- when 'a' => return "array type";
+ when 'a' => return Param_String & "array object";
when 'b' => return Param_String & "boolean object";
when 'c' => return Param_String & "class-wide object";
when 'd' => return Param_String & "decimal object";