From b46088ced20a6f2f0702f1008bf7de31d1c9454e Mon Sep 17 00:00:00 2001 From: ehinrichs <54997013+ehinrichs@users.noreply.github.com> Date: Mon, 22 Apr 2024 10:13:52 -0600 Subject: [PATCH] Revert "Tam debug" --- CMakeLists.txt | 1 - src/dotask.f | 35 ++------------ src/dotask_test.f | 73 ----------------------------- src/fc_mangle.h | 1 - src/lg_c_interface.h | 1 - src/lg_c_wrappers.cpp | 52 +-------------------- src/lg_example.cpp | 41 ---------------- src/lg_example_fortran.f90 | 26 +---------- src/lg_f_interface.h | 8 +--- src/msgtty.f | 95 +++++--------------------------------- 10 files changed, 20 insertions(+), 313 deletions(-) delete mode 100755 src/dotask_test.f mode change 100755 => 100644 src/fc_mangle.h diff --git a/CMakeLists.txt b/CMakeLists.txt index 84f046a9..530d0f7b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -197,7 +197,6 @@ FortranCInterface_HEADER( SYMBOLS INITLAGRIT # syntax: DOTASK - DOTASK_TEST CMO_GET_NAME CMO_GET_INFO CMO_GET_INTINFO diff --git a/src/dotask.f b/src/dotask.f index 0624ba59..8f7f9767 100755 --- a/src/dotask.f +++ b/src/dotask.f @@ -2,13 +2,8 @@ subroutine dotask(task_buff,ierror) C####################################################################### C C PURPOSE - -C execute commands -C -C include file defines globals for command parsing and buffer -C commands_lg.h:C cmd_buffer is a the command buffer -C commands_lg.h: common /ccommands_lg/ clevels, cmd_buff, cmd_temp, -C commands_lg.h: character*16384 cmd_buff, cmd_temp, command C +C execute commands C INPUT c task_buff character string of commands to be added c to command_stack @@ -30,13 +25,8 @@ subroutine dotask(task_buff,ierror) C implicit none include 'commands_lg.h' - -C parameters character*(*) task_buff - integer ierror - -C local variables - integer ierr + integer ierror c ierror=0 nlevels=nlevels+1 @@ -45,24 +35,9 @@ subroutine dotask(task_buff,ierror) clevels(nlevels)='internal_lg' cmd_buff=' ' cmd_buff=task_buff - - call pack_command_lg(ierr) - if (ierr .ne. 0) then - call x3d_error('dotask:','pack_command_lg') - ierror = ierror + 1 - endif - call push_command_lg(ierr) - if (ierr .ne. 0) then - call x3d_error('dotask:','push_command_lg') - ierror = ierror + 1 - endif - call control_command_lg(ierr) - if (ierr .ne. 0) then - call x3d_error('dotask:','control_command_lg') - ierror = ierror + 1 - endif - - + call pack_command_lg(ierror) + call push_command_lg(ierror) + call control_command_lg(ierror) return end diff --git a/src/dotask_test.f b/src/dotask_test.f deleted file mode 100755 index d9ec9c21..00000000 --- a/src/dotask_test.f +++ /dev/null @@ -1,73 +0,0 @@ - subroutine dotask_test(task_buff,ierror) -C####################################################################### -C -C PURPOSE - -C -C Test string passing from cpp -C Do not execute commands, print info -C -c task_buff character string of commands to be added -c to command_stack -c -C####################################################################### -C - implicit none - include 'commands_lg.h' - -C global defines for command parsing and buffer -C check but do not set in this test routine -C commands_lg.h:C cmd_buffer is a the command buffer -C commands_lg.h: common /ccommands_lg/ clevels, cmd_buff, cmd_temp, -C commands_lg.h: character*16384 cmd_buff, cmd_temp, command -C last_char is the location of the last character in cmd_stack -c len_buff is the length of cmd_buffer -c len_cmd is the length of a single command - -C parameters - character*(*) task_buff - integer ierror - -C local variables - integer ierr, icharlnf, ilen - character*132 cbuf -c - ierror=0 - - print*,"" - print*,"Begin FORTRAN dotask_test" - print*,"parameter integer size: ", sizeof(ierr) - - ilen = icharlnf(task_buff) - print*," received string: ",task_buff(1:ilen) - print*," length: ",ilen - print*,"" - print*," check GLOBAL cmd_buff set in dotask calls." - print*," cmd_buff: ",cmd_buff(1:len_buff) - print*," length:",len_buff - - print*,"End FORTRAN dotask_test" - print*,"" - -C ------------------------------------------------------- -C do not process the buffer into command options -C -C call pack_command_lg(ierr) -C if (ierr .ne. 0) then -C call x3d_error('dotask:','pack_command_lg') -C ierror = ierror + 1 -C endif -C call push_command_lg(ierr) -C if (ierr .ne. 0) then -C call x3d_error('dotask:','push_command_lg') -C ierror = ierror + 1 -C endif -C call control_command_lg(ierr) -C if (ierr .ne. 0) then -C call x3d_error('dotask:','control_command_lg') -C ierror = ierror + 1 -C endif -C ------------------------------------------------------- - - return - end - diff --git a/src/fc_mangle.h b/src/fc_mangle.h old mode 100755 new mode 100644 index 49756bc3..2eb32113 --- a/src/fc_mangle.h +++ b/src/fc_mangle.h @@ -17,7 +17,6 @@ /* Mangle some symbols automatically. */ #define INITLAGRIT FortranCInterface_GLOBAL(initlagrit, INITLAGRIT) #define DOTASK FortranCInterface_GLOBAL(dotask, DOTASK) -#define DOTASK_TEST FortranCInterface_GLOBAL_(dotask_test, DOTASK_TEST) #define CMO_GET_NAME FortranCInterface_GLOBAL_(cmo_get_name, CMO_GET_NAME) #define CMO_GET_INFO FortranCInterface_GLOBAL_(cmo_get_info, CMO_GET_INFO) #define CMO_GET_INTINFO FortranCInterface_GLOBAL_(cmo_get_intinfo, CMO_GET_INTINFO) diff --git a/src/lg_c_interface.h b/src/lg_c_interface.h index 76a65407..de974f4c 100644 --- a/src/lg_c_interface.h +++ b/src/lg_c_interface.h @@ -61,7 +61,6 @@ void lg_initlagrit(); /// Send a LaGriT command for processing LG_ERR lg_dotask(const char* cmd); -LG_ERR lg_dotask_test(const char* cmd); LG_ERR lg_cmo_get_name(char* name_buffer, int name_buffer_size); diff --git a/src/lg_c_wrappers.cpp b/src/lg_c_wrappers.cpp index 0cd4a6f1..778796aa 100644 --- a/src/lg_c_wrappers.cpp +++ b/src/lg_c_wrappers.cpp @@ -27,7 +27,7 @@ NOTE: these only work for integer scalars #include "lg_c_interface.h" #include "lg_f_interface.h" -#include "type_sizes.h" + #include #include @@ -75,56 +75,6 @@ LG_ERR lg_dotask(const char* cmd) { } } -// test strings passed from cpp to fortran -// similar to dotask but do not process strings as commands -extern "C" -LG_ERR lg_dotask_test(const char* cmd) { - const char* cmd_finish = "; finish"; - -// arg values passed to fortran should be size 8 -// int_ptrsize is usually integer 8 same as long -// The hidden string length is passed as size_t as 8 bytes on x64 - - int_ptrsize err = 0; - size_t ival = 0; - - printf("Inside C wrapper lg_dotask_test \n"); - printf("received string: %s\n", cmd); - printf("string length: %ld\n", strlen(cmd)); - - if (strlen(cmd) >= (MAX_BUFFER_SIZE - strlen(cmd_finish))) { - return LG_ERR_C_INVALID_ARGS; - } - - char cmd_buffer[MAX_BUFFER_SIZE]; - - int result = snprintf( - cmd_buffer, - MAX_BUFFER_SIZE, - "%s%s", - cmd, - cmd_finish); - - if ((result >= 0) && (result < MAX_BUFFER_SIZE)) { - - printf(" sizeof strlen: %ld\n",sizeof(strlen(cmd_buffer))); - printf(" sizeof err: %ld\n",sizeof(err)); - printf(" sizeof hidden length: %ld\n",sizeof(ival)); - - - printf("sending parameters to FORTRAN dotask_test\n"); - printf("send string: %s\n", cmd_buffer); - printf("string length: %ld\n", strlen(cmd_buffer)); - - DOTASK_TEST(cmd_buffer, &err, strlen(cmd_buffer)); - - return (LG_ERR)err; - - } else { - return LG_ERR_C_INVALID_ARGS; - } -} - extern "C" LG_ERR lg_cmo_get_name(char* name_buffer, int name_buffer_size) { int_ptrsize err = 0; diff --git a/src/lg_example.cpp b/src/lg_example.cpp index fe2cc058..c8024d5b 100644 --- a/src/lg_example.cpp +++ b/src/lg_example.cpp @@ -18,7 +18,6 @@ where integer=8bytes, real*8=8bytes, pointer=8bytes #include "lg_c_interface.h" #include "lg_f_interface.h" -#include "type_sizes.h" #include #include @@ -210,46 +209,6 @@ C ----------------------------------------------------------*/ return; } - -// for testing dotask without processing commands -void dotask_cpp_ () { - - LG_ERR err = 0; - double minmax[6]; - double xreal = 0.0; - long ival= 0; - long itype = 0; - long ierr= 0; - - printf("------------------------------------------\n"); - printf("Inside C++ dotask_cpp \n"); - - char* cmd1[512]; - - printf("send string to wrapper: %s\n\n", "123456789"); - err = lg_dotask_test("123456789"); - -// if needed, test list of commands -/****** - const char* cmds[] = { - "command/one", - "command/two"}; - - for (int i = 0; i < sizeof(cmds)/sizeof(cmds[0]); ++i) { - - printf("send string to wrapper lg_dotask_test: %s\n", cmds[i]); - err = lg_dotask_test(cmds[i]); - - if (err != LG_ERR_SUCCESS) { - printf("dotask_test error: %s\n", cmds[i]); - return; - } - } -******/ - - printf("End C++ dotask_cpp \n"); - printf("------------------------------------------\n"); -} #ifdef __cplusplus } #endif diff --git a/src/lg_example_fortran.f90 b/src/lg_example_fortran.f90 index 198d738e..753e698a 100755 --- a/src/lg_example_fortran.f90 +++ b/src/lg_example_fortran.f90 @@ -1,30 +1,6 @@ -! ##################################################################### -! This file has examples of dotask and get info routines -! Added routines for testing strings - - subroutine test_string(cbuf) -! ##################################################################### -! PURPOSE - -! test string passing between C and fortran calls -! using print to avoid formatting -! ##################################################################### - - implicit none - character*132 cbuf - integer icharlnf, ilen - - ilen = icharlnf(cbuf) - print* - print*,"test_string() received string:" - print*,"length: ",icharlnf(cbuf) - print*,"string: ",cbuf(1:ilen) - - return - end - + subroutine lg_example_fortran(ierror) ! ! - subroutine lg_example_fortran(ierror) ! ##################################################################### ! ! PURPOSE - diff --git a/src/lg_f_interface.h b/src/lg_f_interface.h index cdab1e59..389834db 100644 --- a/src/lg_f_interface.h +++ b/src/lg_f_interface.h @@ -42,10 +42,9 @@ ie define DOTASK FortranCInterface_GLOBAL(dotask, DOTASK) */ #include "fc_mangle.h" -#include "type_sizes.h" #include -// typedef int int_ptrsize; +typedef int int_ptrsize; typedef double real8; #ifdef __cplusplus @@ -69,11 +68,6 @@ extern void DOTASK( int_ptrsize* ierr, size_t cmd_len); -extern void DOTASK_TEST( - const char* cmd, - int_ptrsize* ierr, - size_t cmd_len); - extern void CMO_GET_NAME( const char* name, int_ptrsize* ierr, diff --git a/src/msgtty.f b/src/msgtty.f index d7bcc71f..5d2e77d5 100755 --- a/src/msgtty.f +++ b/src/msgtty.f @@ -804,23 +804,15 @@ subroutine msgtty(imsgout,msgtype,xmsgout,cmsgout,nwds, data ipointi2d, ipointj2d / 0, 0 / character*132 logmess - character*132 cbuf character*32 cmo1, cmo2 character*32 coption C C isubname='msgtty' - -C ierr2 is returned from inside routines that use it -C ierror is used in this routine to flag msgtty errors - ierr2 = 0 - ierror = 0 - C C *************************************************************** C DO THE COMMAND. C -C Get the first word, do not overwrite idsb idsb=cmsgout(1) lenidsb=icharlnf(idsb) C @@ -1582,7 +1574,7 @@ subroutine msgtty(imsgout,msgtype,xmsgout,cmsgout,nwds, * idsb(1:lenidsb).eq.'settets') then C - if(cmsgout(2)(1:6).eq.'normal') then + if(cmsgout(2)(1:lenidsb).eq.'normal') then C *************************************************************** C settets/normal : ASSIGNS INTEGER ID TO ITETCLR C BASED ON 26 POSSIBLE NORMAL DIRECTIONS @@ -2482,84 +2474,25 @@ subroutine msgtty(imsgout,msgtype,xmsgout,cmsgout,nwds, elseif(idsb(1:lenidsb).eq.'test') then C C ************************************************************ -C test : -C default - easy test using creatpts to check executable -C string - string passing tests pending -C cpp - call dotask and get_info c to fortran wrappers -C fort - call dotask and get_info fortran routines used by cpp -C dotask - call dotask_test with no commands processed - - if(nwds.eq.1) then - - call lagrit_test(imsgout,xmsgout,cmsgout,msgtype, - & nwds,ierr2) - - elseif(nwds.ge.2 .and. cmsgout(2)(1:6) .eq. 'string') then - - cbuf="one/two/three/four/end" - call test_string(cbuf) - - elseif(nwds.ge.2 .and. cmsgout(2)(1:6) .eq. 'dotask') then - -C test string is passed from C++ routine to dotask_test() - print*,"msgtty calling dotask_cpp()" - call dotask_cpp() - - elseif(nwds.ge.2 .and. cmsgout(2)(1:3) .eq. 'cpp') then - - write(logmess,'(a)') 'Begin C++ tests.' - call writloga('default',1,logmess,1,ierrw) - call example_cpp() - - elseif(nwds.ge.2 .and. cmsgout(2)(1:4) .eq. 'fort') then - - write(logmess,'(a)') 'Begin FORTRAN tests.' - call writloga('default',1,logmess,1,ierrw) - call lg_example_fortran(ierr2) - - elseif(nwds.ge.2 .and. (cmsgout(2)(1:4) .eq. 'list' - & .or. cmsgout(2)(1:4) .eq. 'help')) then - - print*,"test createpts mesh" - print*,"test/dotask c-fortran string passing" - print*,"test/cpp c-fortran dotask and get_info calls" - print*,"test/fortran fortran dotask and get_info calls" - print*,"test/string simple fortran string test" - - endif +C test : EXECUTE example that can be copied to user_sub.f +C + call lagrit_test(imsgout,xmsgout,cmsgout,msgtype,nwds,ierr2) - else -C ************************************************************ -C command idsb() not found is not an error but give warning + else - write(logmess,9000) idsb(1:lenidsb) - call writloga('default',1,logmess,1,ierrw) - 9000 format("WARNING: Invalid LaGriT generator command: ",a) + ierror=-1 + write(logmess,9000) idsb(1:lenidsb) + call writloga('default',1,logmess,1,ierrw) + 9000 format("WARNING: Invalid LaGriT generator command: ",a) +C endif - -C early exit here +C 9999 continue - -C check for errors from msgtty or called routines - if (ierror .ne. 0) then - write(logmess,'(a,i5)') - * 'MSGTTY PARSER Error: ',ierror - call writloga('default',0,logmess,0,ierrw) - endif - if (ierr2 .ne. 0) then - write(logmess,'(a,i5)') - * 'MSGTTY command returned an error: ',ierr2 - call writloga('default',0,logmess,0,ierrw) - endif - +C return end - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C user define for command usersub1 - subroutine usersub1() C implicit real*8 (a-h,o-z) @@ -2592,10 +2525,6 @@ subroutine usersub1() 9999 continue return end - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C user define for command usersub2 - subroutine usersub2() return end